[编程交流] 选择块内部或交叉点

(defun c:SWCC (/ _pac add ss i e temp it o a b pts tempC i3 ec)
 ;; Select Within/Crossing Curve
 ;; Alan J. Thompson, 03.31.11 / 05.11.11
 (vl-load-com)
 (defun _pac (e / l v d lst)
   (setq d (- (setq v (/ (setq l (vlax-curve-getDistAtParam e (vlax-curve-getEndParam e))) 100.))))
   (while (< (setq d (+ d v)) l)
     (setq lst (cons (trans (vlax-curve-getPointAtDist e d) 0 1) lst))
   )
 )
 (initget 0 "Crossing Within")
 (setq *SWCC:Opt*
        (cond ((getkword (strcat "\nSpecify selection method witin curve [Crossing/Within] <"
                                 (cond (*SWCC:Opt*)
                                       ((setq *SWCC:Opt* "Crossing"))
                                 )
                                 ">: "
                         )
               )
              )
              (*SWCC:Opt*)
        )
 )
 (princ "\nSelect closed curves to select object(s) within: ")
 (if (setq add (ssadd)
           ss  (ssget '((-4 . "<OR")
                        (0 . "CIRCLE,ELLIPSE")
                        (-4 . "<AND")
                        (0 . "*POLYLINE")
                        (-4 . "&=")
                        (70 . 1)
                        (-4 . "AND>")
                        (-4 . "OR>")
                       )
               )
     )
   (progn (repeat (setq i (sslength ss))
            (if (setq temp (ssget "_WP" (_pac (setq e (ssname ss (setq i (1- i)))))))
              (repeat (setq i2 (sslength temp)) (ssadd (ssname temp (setq i2 (1- i2))) add))
            )
            (if (eq *SWCC:Opt* "Crossing")
              (progn (vla-getboundingbox (setq o (vlax-ename->vla-object e)) 'a 'b)
                     (setq pts (mapcar 'vlax-safearray->list (list a b)))
                     (if (setq tempC (ssget "_C"
                                            (list (caar pts) (cadar pts) 0.)
                                            (list (caadr pts) (cadadr pts) 0.)
                                     )
                         )
                       (repeat (setq i3 (sslength tempC))
                         (if (vlax-invoke
                               o
                               'Intersectwith
                               (vlax-ename->vla-object (setq ec (ssname tempC (setq i3 (1- i3)))))
                               acExtendNone
                             )
                           (ssadd ec add)
                         )
                       )
                     )
              )
            )
          )
          (sssetfirst nil add)
          (ssget "_I")
   )
 )
 (princ)
)