[编程交流] 沿多段线分布点

   (defun c:demo2 (/ getPoly ptst pten wall front back exist in seglen pt ppt pc
           pr ptList)
     (vl-load-com)
     (defun getPoly (ent msg);
       (if    (setq ent (car (entsel msg)))
         (if (eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
       ent
         ) ;_if
         (alert "\nThe selected object is not a polyline")
       ) ;_if
     )
     (if (and
       (setq ptst (getpoint "\nStart point of path: "))
       (setq pten (getpoint ptst "\nEndpoint of path: "))
         )
       (progn
         (setq wall (getPoly wall "\nSelect Wall eleveation line"))
         (redraw wall 3)
         (setq front (getPoly front "\nSelect Front eleveation line"))
         (redraw front 3)
         (setq back (getPoly back "\nSelect Back eleveation line"))
         (redraw back 3)
         (setq exist (getPoly exist "\nSelect Exist eleveation line"))
         (mapcar '(lambda (e) (redraw e 4)) (list wall front back))
   ;;;     testing purposes only                ;;;
   ;;;     insert your interval "thingy" here instead    ;;;
         (Setq in 6.25
           seglen in
           ptList nil
         )
   ;;;                            ;;;
     (setq spc (vla-get-modelspace
                  (vla-get-activedocument (vlax-get-acad-object))
         (while (Setq pt (vlax-curve-getPointAtDist wall seglen))
       (setq ppt (vlax-curve-getparamatpoint wall pt))
       (vlax-invoke
         (vlax-ename->vla-object wall)
        (vla-addpoint; add point
          spc
          (vlax-3d-point
            (nth n lst);gets coordinates from list
            (nth (setq n (1+ n)) lst)
          )
        )
        (setq n (1+ n))
         (1+ (fix ppt))
         (progn
           (setq ptList (cons (setq p (list (car pt) (Cadr pt))) ptList))
           p
         )
       )
       (setq seglen (+ seglen in))
         )
         (foreach pline_ (list front back exist)
       (foreach pt ptList
         (setq
           pc (vlax-curve-getClosestPointToProjection pline_ pt '(0 1 0))
         )
         (setq pr (vlax-curve-getparamatpoint pline_ pc))
         (vlax-invoke
           (vlax-ename->vla-object pline_)
           'AddVertex
           (1+ (fix pr))
           (list (car pc) (Cadr pc))
         )
       )
         )
         (foreach p ptList
       (command "xline" "V" "_non" p "")
         )
       )
     )
     (princ)
   )