[编程交流] 地区

(defun c:test (/ p e o l i d w)
 (if (setq e (entlast)
              p (getpoint "\nPick a point in a closed Polyline :")
              )
 (progn
   (command "_.-boundary" "_non" p "")
   (if (and (not (= e (setq o (entlast))))
            (eq (cdr (assoc 0 (entget o))) "LWPOLYLINE")
            )
     (progn
       (setq l (vlax-curve-getdistatparam o (vlax-curve-getendparam o))
             i (/ l 250)
             d i
             )
     (repeat 250
       (setq w (cons (vlax-curve-getpointatdist o d) w)
             d (+ d i)
             )
       )
       (entdel o)
       (sssetfirst nil (ssget "_WP" w))
       )
     )
   )
 )
(princ)
)

(defun c:test ( / selareabypt p )
 (defun selareabypt ( pt / el ss lw i e )
   (vl-load-com)
   (setq el (entlast))
   (setq ss (ssget "_A"
                   (list '(-4 . "<or") 
                           '(-4 . "<and") 
                             '(0 . "LWPOLYLINE") '(38 . 0.0) '(210 0.0 0.0 1.0) 
                           '(-4 . "and>")
                           '(-4 . "<and")
                             '(0 . "POLYLINE") '(10 0.0 0.0 0.0) '(210 0.0 0.0 1.0)
                           '(-4 . "and>")
                           '(-4 . "<and")
                             '(0 . "LINE") '(-4 . "*,*,=") '(10 0.0 0.0 0.0) '(-4 . "*,*,=") '(11 0.0 0.0 0.0)
                           '(-4 . "and>")
                           '(-4 . "<and")
                             '(0 . "ARC") '(-4 . "*,*,=") '(10 0.0 0.0 0.0) '(210 0.0 0.0 1.0)
                           '(-4 . "and>")
                           '(-4 . "<and")
                             '(0 . "CIRCLE") '(-4 . "*,*,=") '(10 0.0 0.0 0.0) '(210 0.0 0.0 1.0)
                           '(-4 . "and>")
                         '(-4 . "or>")
                         (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model"))
                   )
            )
   )
   (repeat (setq i (sslength ss))
     (setq e (ssname ss (setq i (1- i))))
     (if (eq (cdr (assoc 0 (entget e))) "POLYLINE")
       (if (/= (last (assoc 10 (entget (entnext e)))) 0.0)
         (ssdel e ss)
       )
     )
   )
   (command "_.SELECT" ss "")
   (command "_.-BOUNDARY" "_A" "_B" "_N" "_P" "" "_I" "_Y" "_O" "_P" "" "_non" pt "")
   (setq sss (ssadd))
   (if (not (eq el (entlast)))
     (progn
       (setq lw el)
       (while (setq lw (entnext lw))
         (repeat (setq i (sslength ss))
           (setq e (ssname ss (setq i (1- i))))
           (if (vlax-invoke (vlax-ename->vla-object lw) 'intersectwith (vlax-ename->vla-object e) acextendnone)
             (ssadd e sss)
           )
         )
         (entdel lw)
       )
     )
   )
   sss
 )
 (setq p (getpoint "\nPick or specify point inside area : "))
 (sssetfirst nil (selareabypt p))
 (princ)
)

(defun c:test ( / *error* selareabypt p i sss )
 (defun *error* ( msg )
   (if msg
     (prompt msg)
   )
   (princ)
 )
 (defun selareabypt ( pt / el ss lw i e )
   (vl-load-com)
   (setq el (entlast))
   (setq ss (ssget "_A"
                   (list '(-4 . "<or") 
                           '(-4 . "<and") 
                             '(0 . "LWPOLYLINE") '(38 . 0.0) '(210 0.0 0.0 1.0) 
                           '(-4 . "and>")
                           '(-4 . "<and")
                             '(0 . "POLYLINE") '(10 0.0 0.0 0.0) '(210 0.0 0.0 1.0)
                           '(-4 . "and>")
                           '(-4 . "<and")
                             '(0 . "LINE") '(-4 . "*,*,=") '(10 0.0 0.0 0.0) '(-4 . "*,*,=") '(11 0.0 0.0 0.0)
                           '(-4 . "and>")
                           '(-4 . "<and")
                             '(0 . "ARC") '(-4 . "*,*,=") '(10 0.0 0.0 0.0) '(210 0.0 0.0 1.0)
                           '(-4 . "and>")
                           '(-4 . "<and")
                             '(0 . "CIRCLE") '(-4 . "*,*,=") '(10 0.0 0.0 0.0) '(210 0.0 0.0 1.0)
                           '(-4 . "and>")
                         '(-4 . "or>")
                         (cons 410 (if (= 1 (getvar 'cvport)) (getvar 'ctab) "Model"))
                   )
            )
   )
   (repeat (setq i (sslength ss))
     (setq e (ssname ss (setq i (1- i))))
     (if (eq (cdr (assoc 0 (entget e))) "POLYLINE")
       (if (/= (last (assoc 10 (entget (entnext e)))) 0.0)
         (ssdel e ss)
       )
     )
   )
   (command "_.SELECT" ss "")
   (command "_.-BOUNDARY" "_A" "_B" "_N" "_P" "" "_I" "_Y" "_O" "_P" "" "_non" pt "")
   (setq sss (ssadd))
   (if (not (eq el (entlast)))
     (progn
       (setq lw el)
       (while (setq lw (entnext lw))
         (repeat (setq i (sslength ss))
           (setq e (ssname ss (setq i (1- i))))
           (if (vlax-invoke (vlax-ename->vla-object lw) 'intersectwith (vlax-ename->vla-object e) acextendnone)
             (ssadd e sss)
           )
         )
         (entdel lw)
       )
     )
   )
   sss
 )
 (setq p (getpoint "\nPick or specify point inside area : "))
 (if (eq (sslength (setq sss (selareabypt p))) 1)
   (sssetfirst nil sss)
   (progn
     (prompt "\nENTER FOR NEXT ENTITY...ESC TO KEEP CURRENT SELECTION AND TERMINATE ROUTINE...")
     (textscr)
     (repeat (setq i (sslength sss))
       (sssetfirst nil (ssadd (ssname sss (setq i (1- i)))))
       (while (progn (setq gr (grread nil)) (if (or (equal gr '(2 13)) (equal gr '(2 32))) (setq gr nil) t)))
     )
   )
 )
 (*error* nil)
)