[编程交流] 线弧交点？

(defun ssInter (ss / i y Ent1 Ent2 iArr iLst)
 (setq i (sslength ss))
 (while (not (minusp (setq y (1- i) i (1- i))))
   (setq Ent1 (vlax-ename->vla-object (ssname ss i)))
   (while (not (minusp (setq y (1- y))))
     (setq Ent2 (vlax-ename->vla-object (ssname ss y))
       iArr (vlax-variant-value
         (vla-IntersectWith Ent1 Ent2 acExtendNone)))
     (if (> (vlax-safearray-get-u-bound iArr 1) 0)
   (progn
     (setq iLst (vlax-safearray->list iArr))
     (while (not (zerop (length iLst)))
       (setq ptLst (cons (list (car iLst) (cadr iLst) (caddr iLst)) ptLst)
         iLst (cdddr iLst))))))))
(defun c:test (/ ptLst)
 (vl-load-com)
 (ssInter (ssget))
 (alert (vl-princ-to-string ptLst))
 (princ))

(defun ssInter (ss / vLst i j obj1 obj2 iArr iLst)
 (setq vLst (mapcar 'vlax-ename->vla-object
            (vl-remove-if 'listp
              (mapcar 'cadr (ssnamex ss))))
   i (length vLst))
 (while (not (minusp (setq j (1- i) i (1- i))))
   (setq obj1 (nth i vLst))
   (while (not (minusp (setq j (1- j))))
     (setq obj2 (nth j vLst)
       iArr (vlax-variant-value
         (vla-IntersectWith obj1 obj2 acExtendNone)))      
     (if (> (vlax-safearray-get-u-bound iArr 1) 0)
   (progn
     (setq iLst (vlax-safearray->list iArr))
     (while (not (zerop (length iLst)))
       (setq ptLst (cons (list (car iLst) (cadr iLst) (caddr iLst)) ptLst)
         iLst (cdddr iLst))))))))
(defun c:test (/ ptLst)
 (vl-load-com)
 (ssInter (ssget))
 (alert (vl-princ-to-string ptLst))
 (princ))