[编程交流] 重复测量

(repeat ([color="red"]1+[/color] (fix (/ (apply 'distance basePtLst) dist)))

(vl-load-com)
(defun KGA_List_Divide_3 (lst / ret)
 (repeat (/ (length lst) 3)
   (setq ret (cons (list (car lst) (cadr lst) (caddr lst)) ret))
   (setq lst (cdddr lst))
 )
 (reverse ret)
)
(defun KGA_Sys_ObjectOwner (obj)
 (vla-objectidtoobject (vla-get-database obj) (vla-get-ownerid obj))
)
(defun DimCurveAtPoint (curve pt / space tmp)
 (setq space (KGA_Sys_ObjectOwner curve))
 (setq tmp (vlax-invoke space 'addxline pt (mapcar '+ '(0.0 1.0 0.0) pt)))
 (foreach int (KGA_List_Divide_3 (vlax-invoke curve 'intersectwith tmp acextendnone))
   (vlax-invoke space 'adddimaligned pt int pt)
 )
 (vla-delete tmp)
)
(defun c:DimCurve ( / baseEntselLst basePtLst curve dist doc pt vec)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (if
   (and
     (setq curve (car (entsel "\nSelect curve: ")))
     (setq baseEntselLst (entsel "\nSelect base line near start point: "))
     (setq dist (getdist "\nDistance between dimensions: "))
   )
   (progn
     (setq pt (cadr baseEntselLst))
     (setq basePtLst
       (list
         (vlax-curve-getstartpoint (car baseEntselLst))
         (vlax-curve-getendpoint (car baseEntselLst))
       )
     )
     (if (> (distance pt (car basePtLst)) (distance pt (cadr basePtLst)))
       (setq basePtLst (reverse basePtLst))
     )
     (setq curve (vlax-ename->vla-object curve))
     (setq pt (car basePtLst))
     (setq vec
       (list
         (if (> (caar basePtLst) (caadr basePtLst)) (- dist) dist)
         0.0
         0.0
       )
     )
     (repeat (1+ (fix (/ (apply 'distance basePtLst) dist))) ; Thanks Grrr.
       (DimCurveAtPoint curve pt)
       (setq pt (mapcar '+ pt vec))
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)