[编程交流] 根据距离对三维多段线排序

(defun c:nn  (/ )   
(princ "\n Select 3d polyline :")
 (setq entlst'()) 
 (setq sel (ssget'((0 . "POLYLINE"))))
 (repeat (setq idx (sslength sel))
         (setq ent (ssname sel (setq idx (- idx 1)))
                     enx (entget ent)
               )
   (setq name(cdr(assoc -1 enx)))
   (setq entlst(cons name entlst))
   )
 )

(defun c:Test (/ s o d ss i p sn lst _lst l r pts data)
 (princ "\nPick LWpolyline :")
 (if (setq s (ssget "_+.:S:E" '((0 . "LWPOLYLINE"))))
   (progn
     (setq o (vlax-ename->vla-object (ssname s 0))
           d (vlax-get-acad-object)
           )
     (vla-getboundingbox o 'l 'r)
     (vla-zoomwindow d r l)
     (setq pts (mapcar 'vlax-safearray->list (list l r)))
     (if (setq ss (ssget "_C" (car pts) (cadr pts) '((0 . "POLYLINE"))))
       (repeat (setq i (sslength ss))
         (if (setq p (vlax-invoke
                       o
                       'intersectwith
                       (vlax-ename->vla-object
                         (setq sn (ssname ss (setq i (1- i))))
                         )
                       acextendnone
                       )
                   )
           (setq lst (cons (list (vlax-curve-getdistatpoint o p)
                                 (cdr (assoc -1 (entget sn)))
                                 )
                           lst
                           )
                 )
           )
         )
       )
     (if lst
       (setq _lst (vl-sort lst '(lambda (j k) (< (car j) (car k))))
             data (mapcar 'cadr _lst)
             )
       )
     (vla-zoomprevious d)
     )
   )
 (princ)
 ) (vl-load-com)

(defun c:sortenamesbyfenceselectionofpickedcurve ( / curve d fd n k p pl ss1 sss ss2 ss enames )
 (vl-load-com)
 (setq curve (car (entsel "\nPick selecting curve...")))
 (while (or (not curve) (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getstartpoint (list curve))))
   (prompt "\nMissed or picked entity doesn't belong to curves... Please try picking correct curve entity again...")
   (setq curve (car (entsel)))
 )
 (initget 7)
 (setq fd (getdist (strcat "\nPick or specify fence distance for selecting by fence along picked curve in interval from 0.0 to " (rtos (setq d (vlax-curve-getdistatparam curve (vlax-curve-getendparam curve))) 2 50) " : ")))
 (setq n (1+ (fix (/ d fd))))
 (setq fd (/ d n))
 (setq k -1)
 (repeat (1+ n)
   (setq p (vlax-curve-getpointatdist curve (* fd (setq k (1+ k)))))
   (setq pl (cons p pl))
 )
 (setq pl (reverse pl))
 (if (equal (car pl) (vlax-curve-getstartpoint curve) 1e-6) (setq pl (subst (vlax-curve-getstartpoint curve) (car pl) pl)))
 (if (equal (last pl) (vlax-curve-getendpoint curve) 1e-6) (setq pl (subst (vlax-curve-getendpoint curve) (last pl) pl)))
 (setq ss1 (ssget "_C" (mapcar '- (car pl) '(1e-3 1e-3)) (mapcar '+ (car pl) '(1e-3 1e-3))))
 (ssdel curve ss1)
 (setq sss (ssget "_F" pl))
 (ssdel curve sss)
 (setq ss2 (ssget "_C" (mapcar '- (last pl) '(1e-3 1e-3)) (mapcar '+ (last pl) '(1e-3 1e-3))))
 (ssdel curve ss2)
 (setq ss (acet-ss-union (list ss1 sss ss2)))
 (setq enames (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
 (foreach ename enames
   (redraw ename 2)
   (if (or (eq ename (car enames)) (eq ename (last enames)))
     (repeat 750 (redraw))
     (repeat 250 (redraw))
   )
   (redraw ename 1)
 )
 (princ)
)
(defun c:sebfspc nil (c:sortenamesbyfenceselectionofpickedcurve))

(princ data)