本帖最后由 st788796 于 2013-12-13 13:11 编辑
Ok 了,不用转坐标系 Curve 可以按指定的 线投影了,再处理后就可以用于绘制各方向侧视图
 - (defun ProjectCurves (curve v d / box outbox v1 ptl el)
- (setq box (xdrx_entity_box curve)
- outBox (apply 'xdrx_points_offset (cons d (XD::Pnts:Close box)))
- v (xdrx_vector_normalize v)
- v1 (xdrx_vector_normalize (xdrx_vector_perpvector v))
- ptl (mapcar
- '(lambda (x y / e)
- (setq ss (xdrx_curve_getProjectCurve curve (list x y))
- el (cons (ssname ss 0) el)
- ss (xdrx_curve_getprojectcurve
- ss
- '((0. 0. 0.) (0. 0. 1.))
- )
- el (cons (ssname ss 0) el)
- )
- (xdrx_getpropertyvalue
- (car el)
- "Vertices"
- )
- )
- outbox
- (list v1 v v1 v)
- )
- )
- (mapcar 'xdrx_entity_delete el)
- (mapcar '(lambda (x) (xdrx_polyline_compress (apply 'xdrx_polyline_make x)))
- (mapcar '(lambda (a)
- (vl-sort a
- '(lambda (e1 e2)
- (if (equal (cadr e1) (cadr e2) 1e-3)
- (< (car e1) (car e2))
- (< (cadr e1) (cadr e2))
- )
- )
- )
- )
- ptl
- )
- )
- )
- (defun c:tt (/ e p1 p2 d)
- (and (setq
- e (car (xdrx_entsel "\nPick Pline: " '((0 . "lwpolyline"))))
- )
- (setq p1 (getpoint "\nFirst point: "))
- (setq p2 (getpoint p1 "\nSecond point: "))
- (setq d (getdist p1 "\nSpace: "))
- (ProjectCurves e (mapcar '- p2 p1) d)
- )
- (princ)
- )
|