[编程交流] 标记相交距离

(defun c:mark_intersections_of_1st_curve_on_2nd ( / unique g3 c1 c2 ss i ent p pl d dl pn pnl )
 (vl-load-com)
 
 (defun unique ( l ) (if l (cons (car l) (unique (vl-remove (car l) (cdr l))))))
 
 (defun g3 ( l ) (if l (cons (list (car l) (cadr l) (caddr l)) (g3 (cdddr l)))))
 
 (setq c1 (car (entsel "\nPick first curve that has intersections")))
 (while (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartparam (list c1)))
   (prompt "\nPicked entity don't belong to curves... Try again...")
   (setq c1 (car (entsel "\nPick first curve that has intersections")))
 )
 (setq ss (ssget "_X"))
 (setq c2 (car (entsel "\nPick second curve that should be marked with intersections of first curve")))
 (while (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartparam (list c2)))
   (prompt "\nPicked entity don't belong to curves... Try again...")
   (setq c2 (car (entsel "\nPick second curve that should be marked with intersections of first curve")))
 )
 (setq i -1)
 (while (setq ent (ssname ss (setq i (1+ i))))
   (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartparam (list ent)))
     (ssdel ent ss)
   )
 )
 (ssdel c1 ss)
 (ssdel c2 ss)
 (setq i -1)
 (while (setq ent (ssname ss (setq i (1+ i))))
   (if (setq p (vlax-invoke (vlax-ename->vla-object c1) 'intersectwith (vlax-ename->vla-object ent) acextendnone))
     (foreach p (g3 p)
       (setq pl (cons p pl))
     )
   )
 )
 (setq pl (unique pl))
 (foreach p pl
   (setq d (vlax-curve-getdistatpoint c1 p))
   (setq dl (cons d dl))
 )
 (foreach d dl
   (setq pn (vlax-curve-getpointatdist c2 d))
   (setq pnl (cons pn pnl))
 )
 (foreach pn pnl
   (entmake (list '(0 . "POINT") (cons 10 pn)))
 )
 (if (not (member (vlax-curve-getstartpoint c2) pnl))
   (entmake (list '(0 . "POINT") (cons 10 (vlax-curve-getstartpoint c2))))
 )
 (if (not (member (vlax-curve-getendpoint c2) pnl))
   (entmake (list '(0 . "POINT") (cons 10 (vlax-curve-getendpoint c2))))
 )
 (princ)
)
(defun c:mi1st2nd nil (c:mark_intersections_of_1st_curve_on_2nd))