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

(defun c:Test () 
 (vl-load-com) 
 (setq ent1 (vlax-ename->vla-object (car (entsel "First entity: "))) 
ent2 (vlax-ename->vla-object (car (entsel "Second entity: "))) 
 ) 
 (vlax-safearray->list 
   (vlax-variant-value 
     (vla-IntersectWith ent1 ent2 acExtendnone) 
   ) 
 ) 
)

([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 (2D-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] 2D-poly-inters ( lwp 3dp [color=BLUE]/[/color] enx ls1 ls2 vtx )
   ([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] vtx ([color=BLUE]assoc[/color] 10 enx)
             ls2 ([color=BLUE]cons[/color] ([color=BLUE]list[/color] ([color=BLUE]cadr[/color] vtx) ([color=BLUE]caddr[/color] vtx)) 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]inters[/color] a b c d)
                               )
                           )
                           ls1 ([color=BLUE]cdr[/color] ls1)
                       )
                   )
               )
           )
           ls2 ([color=BLUE]cdr[/color] ls2)
       )
   )
)

(defun c:TesT ( / s1 s2 PP)
   (if
       (and
           (princ "\nSelect First 2D/3D Polyline")
           (setq s1 (ssget  "_+.:S" '((0 . "*POLYLINE"))))
           (princ "\nSelect Second 2D/3D Polyline ")
           (setq s2 (ssget  "_+.:S" '((0 . "*POLYLINE"))))
       )
       (progn
           (setq s1 (ssname s1 0))
           (setq s2 (ssname s2 0))
           (if (setq PP (3D_poly_inters s1 s2))
               (foreach x PP
                   (entmake (list '(0 . "CIRCLE") '(40 . 1.0) (cons 10 x)))
               )
           )            
       )
   )
)
(defun 3D_poly_inters (PL1 PL2 / vPL1 vPL2 zmin zmax p- p+ p_int)
   (setq vPL1 (pl_coord PL1))
   (setq vPL2 (pl_coord PL2))
   (mapcar
      '(lambda (x)
            (or zmin (setq zmin (last x)))
            (or zmax (setq zmax (+ zmin 0.01)))                     
            (if (< (last x) zmin) (setq zmin (last x)))
            (if (> (last x) zmax) (setq zmax (last x)))
       )
       vPL1
   )            
   (if (= 1 (logand 1 (cdr (assoc 70 (entget PL1)))))
       (setq vPL1 (cons (last vPL1) vPL1))
   )
   (if (= 1 (logand 1 (cdr (assoc 70 (entget PL2)))))
       (setq vPL2 (cons (last vPL2) vPL2))
   )
   (mapcar
       '(lambda ( a b )
            (mapcar
                '(lambda ( c d )
                     (if
                         (setq p
                              (inters
                                  (list (car a) (cadr a))
                                  (list (car b) (cadr b))
                                  (list (car c) (cadr c))
                                  (list (car d) (cadr d))
                              )
                         )
                         (progn
                             (setq p- (list (car p) (cadr p) zmin))
                             (setq p+ (list (car p) (cadr p) zmax))
                             (setq p (inters a b p- p+))
                             (setq p_int (cons p p_int))
                         )
                     )
                 )
                vPL2 (cdr vPL2)                  
           )
       )
       vPL1 (cdr vPL1)
   )
   p_int
)
(defun pl_coord (# / p m)
   (setq p (if (vlax-curve-IsClosed #)
               (fix (vlax-curve-getEndParam #))
               (1+ (fix (vlax-curve-getEndParam #)))
           )
   )
   (while (/= 0 p)
       (setq m (cons (vlax-curve-getPointAtParam # (setq p (1- p))) m))
   )
)
(vl-load-com)

(reverse (cdr (reverse vPL2)))

_$ (mapcar '+ '(1 2 3 4 5) '(2 3 4 5))
(3 5 7 9)