这个GetProjectCurve生成的选集如何删除

st788796 · 发表于 2013-12-13 10:36:48

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

又搞不清API在选集分配了，问题怎么把临时线删掉

本函数是用来测试曲线各个方向的投影，以后可以用来绘制侧视图

(defun ProjectCurves (curve v d / box outbox v1)
(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))
)
(mapcar
'(lambda (x y / ss pts el)
(xdrx_setmark)
(xdrx_curve_getProjectCurve curve (list x y));_这个是临时的，如何删除？
(setq el (xdrx_pickset->ents (setq ss (xdrx_getss))));_始终是一个?
(setq
ss (xdrx_curve_getprojectcurve ss '((0. 0. 0.) (0. 0. 1.)))
)
(setq
pts (vl-sort (xdrx_getpropertyvalue (ssname ss 0) "Vertices")
'(lambda (p1 p2)
(if (equal (cadr p1) (cadr p2) 1e-3)
(< (car p1) (car p2))
(< (cadr p1) (cadr p2))
)
)
)
)
(apply 'xdrx_polyline_make pts);_WCS
(mapcar 'xdrx_entity_delete el)
)
outbox
(list v1 v v1 v)
)
)

(defun ProjectCurves (curve v d / box outbox v1) 
  (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)) 
  ) 
  (mapcar 
    '(lambda (x y / ss pts el) 
       (xdrx_setmark) 
       (xdrx_curve_getProjectCurve curve (list x y));_这个是临时的，如何删除？ 
       (setq el (xdrx_pickset->ents (setq ss (xdrx_getss))));_始终是一个? 
       (setq 
         ss (xdrx_curve_getprojectcurve ss '((0. 0. 0.) (0. 0. 1.))) 
       ) 
       (setq 
         pts (vl-sort (xdrx_getpropertyvalue (ssname ss 0) "Vertices") 
                      '(lambda (p1 p2) 
                         (if (equal (cadr p1) (cadr p2) 1e-3) 
                           (< (car p1) (car p2)) 
                           (< (cadr p1) (cadr p2)) 
                         ) 
                       ) 
             ) 
       ) 
       (apply 'xdrx_polyline_make pts);_WCS 
       (mapcar 'xdrx_entity_delete el) 
     ) 
    outbox 
    (list v1 v v1 v) 
  ) 
)

XDSoft · 发表于 2013-12-13 11:10:24

(xdrx_setmark )
....
(setq ss (xdrx_getss 9))

st788796 · 发表于 2013-12-13 11:35:45

知道问题所在了, mapcar 的时候不是一个选集，后面的会冲掉前面的，收集要用 cons

st788796 · 发表于 2013-12-13 13:03:24

本帖最后由 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)
)

(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) 
)

账号		自动登录	找回密码
密码			立即注册

[研讨] 这个GetProjectCurve生成的选集如何删除

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子