winerfjy 发表于 2015-8-23 09:52:05

选择相连的对象

能来能把能选择的对象改成尺寸链
(defun c:css ( / en fl in l1 l2 s1 s2 sf vl )
    (setq sf
      (list
         '(-4 . "<OR")
               '(0 . "LINE,ARC")
               '(-4 . "<AND")
                   '(0 . "LWPOLYLINE,SPLINE")
                   '(-4 . "<NOT")
                     '(-4 . "&=")
                     '(70 . 1)
                   '(-4 . "NOT>")
               '(-4 . "AND>")
               '(-4 . "<AND")
                   '(0 . "POLYLINE")
                   '(-4 . "<NOT")
                     '(-4 . "&")
                     '(70 . 89)
                   '(-4 . "NOT>")
                   '(-4 . "AND>")
               '(-4 . "<AND")
                   '(0 . "ELLIPSE")
                   '(-4 . "<OR")
                     '(-4 . "<>")
                     '(41 . 0.0)
                     '(-4 . "<>")
                        (cons 42 (+ pi pi))
                   '(-4 . "OR>")
               '(-4 . "AND>")
         '(-4 . "OR>")
            (if (= 1 (getvar 'cvport))
                (cons 410 (getvar 'ctab))
               '(410 . "Model")
            )
      )
    )
    (if (setq s1 (ssget "_X" sf))
      (if (setq en (ssget "_+.:E:S" sf))
            (progn
                (setq s2 (ssadd)
                      en (ssname en 0)
                      l1 (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en))
                )
                (repeat (setq in (sslength s1))
                  (setq en (ssname s1 (setq in (1- in)))
                        vl (cons (list (vlax-curve-getstartpoint en) (vlax-curve-getendpoint en) en) vl)
                  )
                )
                (while
                  (progn
                        (foreach v vl
                            (if (vl-some '(lambda ( p ) (or (equal (car v) p 1e-8) (equal (cadr v) p 1e-8))) l1)
                              (setq s2 (ssadd (caddr v) s2)
                                    l1 (vl-list* (car v) (cadr v) l1)
                                    fl t
                              )
                              (setq l2 (cons v l2))
                            )
                        )
                        fl
                  )
                  (setq vl l2 l2 nil fl nil)
                )
            )
      )
      (princ "\nNo valid objects found.")
    )
    (sssetfirst nil s2)
    (princ)
)
(vl-load-com) (princ)


434939575 发表于 2015-8-23 10:30:22

这个写得好！谢谢分享！

edata 发表于 2015-8-23 12:28:07

这个叫做 选择首尾相连线，
和闪电链一样。。

冒个烟圈 发表于 2015-9-8 21:46:30

这是个好东西，CAD选择最大的缺陷是不能像UG和PROE一样“链选取”

guankuiwu 发表于 2022-10-16 10:16:47

很好的功能！
页: [1]
查看完整版本: 选择相连的对象