[编程交流] 测量多段线并指定

(defun c:pldiv (/ actDoc spFlag actSp poly
        sumDis nextPt oldDist oldNum)
 (vl-load-com)
 (setq actDoc(vla-get-ActiveDocument
         (vlax-get-acad-object))
 spFlag(vla-get-ActiveSpace actDoc)
       ); end setq
(if(= 0 spFlag)
 (setq actSp(vla-get-PaperSpace actDoc))
 (setq actSp(vla-get-ModelSpace actDoc))
); end if
 (if(not pldiv:dist)(setq pldiv:dist 1.0))
 (if(not pldiv:num)(setq pldiv:num 1))
  (setq stFlag T
        sumDis 0.0
 oldDist pldiv:dist
 oldNum pldiv:num
 pldiv:dist
  (getdist
    (strcat
      "\nSpecify distance <"(rtos pldiv:dist)">: "))
 pldiv:num
  (getint
    (strcat
      "\nSpecify start number <"(itoa pldiv:num)">: "))
 ); end setq
 (if(not pldiv:dist)(setq pldiv:dist oldDist))
 (if(not pldiv:num)(setq pldiv:num oldNum))
 (princ "\n*** Select line, polyline or spline *** ")
 (if
   (and
   (setq poly
    (ssget "_:S"
     '((0 . "*LINE")(-4 . "<NOT")(0 . "MLINE")(-4 . "NOT>"))))
   (setq nextPt
   (getpoint "\nSpecify start point at curve > "))
   (vlax-curve-getDistAtPoint
     (setq poly(vlax-ename->vla-object(ssname poly 0)))
     nextPt)
   ); end and    
   (progn
     (setq next_vtx_param 1
  next_vtx_dist (vlax-curve-getDistAtParam poly next_vtx_param)
  ); end setq
     (while nextPt
  (while (> sumDis next_vtx_dist) 
 (progn
 (setq VtxPt(vlax-curve-getPointAtParam poly next_vtx_param))
 (vla-AddPoint actSp(vlax-3d-point VtxPt))
 (vla-AddText actSp (itoa pldiv:num)
    (vlax-3d-point VtxPt)(getvar "TEXTSIZE"))
 (setq next_vtx_param (+ 1 next_vtx_param)
       next_vtx_dist (vlax-curve-getDistAtParam poly next_vtx_param)
       pldiv:num(1+ pldiv:num)
       );end set q
 ) ; end progn
  );end while
(vla-AddPoint actSp(vlax-3d-point nextPt))
(vla-AddText actSp (itoa pldiv:num)
   (vlax-3d-point nextPt)(getvar "TEXTSIZE"))  
(setq  sumDis (+ sumDis pldiv:dist)
 pldiv:num(1+ pldiv:num)
        nextPt(vlax-curve-getPointAtDist poly sumDis)
       ); end setq
      ); end while
     (setq endParam (vlax-curve-getEndParam poly)
           EndPoint(vlax-curve-getPointAtParam poly endParam))
      (vla-AddPoint actSp(vlax-3d-point EndPoint))
(vla-AddText actSp (itoa pldiv:num)
   (vlax-3d-point EndPoint)(getvar "TEXTSIZE"))  
     ); end progn
   (princ "\nERROR. Empty selection, invalid object type or point not at curve. ")
   ); end if
 (princ)
 );