[编程交流] Vla中与f相交的问题

([color=BLUE]defun[/color] c:test ( [color=BLUE]/[/color] e i j s1 s2 )
   ([color=BLUE]if[/color]
       ([color=BLUE]and[/color]
           ([color=BLUE]princ[/color] [color=MAROON]"\nSelect LWPolylines..."[/color])
           ([color=BLUE]setq[/color] s1 ([color=BLUE]ssget[/color] '((0 . [color=MAROON]"LWPOLYLINE"[/color]))))
           ([color=BLUE]princ[/color] [color=MAROON]"\nSelect 3D Polylines..."[/color])
           ([color=BLUE]setq[/color] s2 ([color=BLUE]ssget[/color] '((0 . [color=MAROON]"POLYLINE"[/color]) (-4 . [color=MAROON]"&="[/color]) (70 . )))
       )
       ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] i ([color=BLUE]sslength[/color] s1))
           ([color=BLUE]setq[/color] e ([color=BLUE]ssname[/color] s1 ([color=BLUE]setq[/color] i ([color=BLUE]1-[/color] i))))
           ([color=BLUE]repeat[/color] ([color=BLUE]setq[/color] j ([color=BLUE]sslength[/color] s2))
               ([color=BLUE]foreach[/color] x (3D-poly-inters e ([color=BLUE]ssname[/color] s2 ([color=BLUE]setq[/color] j ([color=BLUE]1-[/color] j))))
                   ([color=BLUE]entmake[/color] ([color=BLUE]list[/color] '(0 . [color=MAROON]"CIRCLE"[/color]) '(40 . 1.0) ([color=BLUE]cons[/color] 10 x)))
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)
([color=BLUE]defun[/color] 3D-poly-inters ( lwp 3dp [color=BLUE]/[/color] enx ls1 ls2 )
   ([color=BLUE]setq[/color] ls1 ([color=BLUE]mapcar[/color] '[color=BLUE]cdr[/color] ([color=BLUE]vl-remove-if-not[/color] '([color=BLUE]lambda[/color] ( x ) ([color=BLUE]=[/color] 10 ([color=BLUE]car[/color] x))) ([color=BLUE]entget[/color] lwp)))
         3dp ([color=BLUE]entnext[/color] 3dp)
         enx ([color=BLUE]entget[/color]  3dp)
   )
   ([color=BLUE]while[/color] ([color=BLUE]=[/color] [color=MAROON]"VERTEX"[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 0 enx)))
       ([color=BLUE]setq[/color] ls2 ([color=BLUE]cons[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 10 enx)) ls2)
             3dp ([color=BLUE]entnext[/color] 3dp)
             enx ([color=BLUE]entget[/color]  3dp)
       )
   )
   ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]logand[/color] 1 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 70 ([color=BLUE]entget[/color] ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 330 enx)))))))
       ([color=BLUE]setq[/color] ls2 ([color=BLUE]cons[/color] ([color=BLUE]last[/color] ls2) ls2))
   )
   ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]logand[/color] 1 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 70 ([color=BLUE]entget[/color] lwp)))))
       ([color=BLUE]setq[/color] ls1 ([color=BLUE]cons[/color] ([color=BLUE]last[/color] ls1) ls1))
   )
   ([color=BLUE]apply[/color] '[color=BLUE]append[/color]
       ([color=BLUE]mapcar[/color]
           ([color=BLUE]function[/color]
               ([color=BLUE]lambda[/color] ( a b )
                   ([color=BLUE]vl-remove[/color] [color=BLUE]nil[/color]
                       ([color=BLUE]mapcar[/color]
                           ([color=BLUE]function[/color]
                               ([color=BLUE]lambda[/color] ( c d [color=BLUE]/[/color] p )
                                   ([color=BLUE]if[/color] ([color=BLUE]setq[/color] p ([color=BLUE]inters[/color] a b c d))
                                       ([color=BLUE]inters[/color] a b ([color=BLUE]append[/color] p '(0.0)) ([color=BLUE]append[/color] p '(1.0)) [color=BLUE]nil[/color])
                                   )
                               )
                           )
                           ls1 ([color=BLUE]cdr[/color] ls1)
                       )
                   )
               )
           )
           ls2 ([color=BLUE]cdr[/color] ls2)
       )
   )
)

(defun c:test ( / e i j s1 s2 )
   (if
       (and
           (princ "\nSelect LWPolylines...")
           (setq s1 (ssget '((0 . "LWPOLYLINE"))))
           (princ "\nSelect 3D Polylines...")
           (setq s2 (ssget '((0 . "POLYLINE") (-4 . "&=") (70 . )))
       )
       (repeat (setq i (sslength s1))
           (setq e (ssname s1 (setq i (1- i))))
           (repeat (setq j (sslength s2))
               (foreach x (2D-poly-inters e[color="blue"] (setq e2 (ssname s2 (setq j (1- j)))))[/color]
                   (entmake (list '(0 . "CIRCLE") '(40 . 1.0) [color="blue"](cons 10 (vlax-curve-getclosestpointto e2 x))))[/color]
                                                                                        
               )
           )
       )
   )
   (princ)
)
(defun 2D-poly-inters ( lwp 3dp / enx ls1 ls2 vtx )
   (setq ls1 (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget lwp)))
         3dp (entnext 3dp)
         enx (entget  3dp)
   )
   (while (= "VERTEX" (cdr (assoc 0 enx)))
       (setq vtx (assoc 10 enx)
             ls2 (cons (list (cadr vtx) (caddr vtx)) ls2)
             3dp (entnext 3dp)
             enx (entget  3dp)
       )
   )
   (if (= 1 (logand 1 (cdr (assoc 70 (entget (cdr (assoc 330 enx)))))))
       (setq ls2 (cons (last ls2) ls2))
   )
   (if (= 1 (logand 1 (cdr (assoc 70 (entget lwp)))))
       (setq ls1 (cons (last ls1) ls1))
   )
   (apply 'append
       (mapcar
           (function
               (lambda ( a b )
                   (vl-remove nil
                       (mapcar
                           (function
                               (lambda ( c d )
                                   (inters a b c d)
                               )
                           )
                           ls1 (cdr ls1)
                       )
                   )
               )
           )
           ls2 (cdr ls2)
       )
   )
)