[编程交流] Lisp沿z a移动对象

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
 (if ss
   (repeat (setq i (sslength ss))
     (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
   )
 )
)
(defun c:Test ( / cur doc end errCnt inc lnObj ss sta vec)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (if
   (and
     (setq sta (getpoint "\nStart point of temporary line (line may intersect every polyline only once!): "))
     (setq end (getpoint sta "\nEnd point of temporary line: "))
     (setq ss (ssget "_F" (list sta end) '((0 . "LWPOLYLINE") (62 . 1))))
     (setq inc (getreal "\nDistance between sections: "))
   )
   (progn
     (setq ss (KGA_Conv_Pickset_To_ObjectList ss))
     (setq errCnt 0)
     (setq vec (trans (list 0.0 0.0 (- inc)) 0 (vlax-get (car ss) 'normal))) ; Use the normal of the first object in ss.
     (setq cur '(0.0 0.0 0.0))
     (setq lnObj (vlax-invoke (vla-get-modelspace doc) 'addline (setq sta (trans sta 1 0)) (trans end 1 0)))
     (foreach
       plObj
       (mapcar
         'cadr
         (vl-sort
           (vl-remove
             nil
             (mapcar
               '(lambda (plObj / coordLst)
                 (setq coordLst (vlax-invoke lnObj 'intersectwith plObj acextendnone))
                 (if (= 3 (length coordLst))
                   (list (distance sta coordLst) plObj)
                   (progn
                     (setq errCnt (1+ errCnt))
                     nil
                   )
                 )
               )
               ss
             )
           )
           '(lambda (a b) (< (car a) (car b)))
         )
       )
       (vlax-invoke plObj 'move '(0.0 0.0 0.0) (setq cur (mapcar '+ cur vec)))
     )
     (vla-delete lnObj)
     (if (/= 0 errCnt)
       (princ (strcat "\nError: skipped " (itoa errCnt) " polyline(s) that were intersected more than once "))
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)