点取矩形或多边形的某一边，或点取多段线的某一段，就得到该边或该段的长度，代码怎么

clh521

lisp学的不精，想问下，点取矩形或多边形的某一边，或点取多段线的某一段，就得到该边或该段的长度，代码怎么写？谢

byghbcx

(defun test ()
(setq ent (entsel))
(setq en (car ent) pt (cadr ent))
(setq pa (vlax-curve-getParamAtPoint (vlax-ename->vla-object en) (vlax-curve-getClosestPointTo (vlax-ename->vla-object en) pt)))
(setq n (fix pa))
(setq dist1 (vlax-curve-getDistAtParam (vlax-ename->vla-object en) (fix pa)))
(setq dist2 (vlax-curve-getDistAtParam (vlax-ename->vla-object en) (1+ (fix pa))))
(setq dist (- dist2 dist1))
(setq pt1 (vlax-curve-getpointAtParam (vlax-ename->vla-object en) (fix pa))
      pt2 (vlax-curve-getpointAtParam (vlax-ename->vla-object en) (1+ (fix pa))))
(command "dimaligned" pt1 pt2 (polar pt1 (+ (* 0.5 pi) (angle pt1 pt2)) (* 0.2 dist)))
      dist
      )

clh521

谢谢byghbcx，程序非常很好，连标注都标出来了。但是我忘了说了，点击用line命令画的单条直线就不行，能改怎么改啊？

s678z

用len命令就可知道线段长度

byghbcx

优化了一下，支持直线、圆弧
(defun test (/ ent en pt pa dist1 dist2 pt1 pt2 bu dist);点取多段线的某一段，就得到该边或该段的长度标注，支持直线，圆弧
(while (setq ent (entsel))
(setq en (car ent) pt (cadr ent))
(cond
   ((wcmatch (cdr (assoc 0 (entget en))) "*LINE")
(setq pa (vlax-curve-getParamAtPoint (vlax-ename->vla-object en) (vlax-curve-getClosestPointTo (vlax-ename->vla-object en) pt)))
  (setq dist1 (vlax-curve-getDistAtParam (vlax-ename->vla-object en) (fix pa)))
(setq dist2 (vlax-curve-getDistAtParam (vlax-ename->vla-object en) (1+ (fix pa))))
(setq dist (- dist2 dist1))
(setq pt1 (vlax-curve-getpointAtParam (vlax-ename->vla-object en) (fix pa))
       pt2 (vlax-curve-getpointAtParam (vlax-ename->vla-object en) (1+ (fix pa))))
(if (= (cdr (assoc 0 (entget en))) "LINE")
    (setq pt1 (vlax-curve-getStartPoint (vlax-ename->vla-object en))
          pt2 (vlax-curve-getEndPoint (vlax-ename->vla-object en))
          dist (distance pt1 pt2)
          bu 0
   )
   (setq bu (vla-getbulge (vlax-ename->vla-object en) (fix pa)))
    )
(if (/= bu 0) (command "dimangular"  pt "t" (rtos dist 2 2)
                       (if (< bu 0) (polar pt1 (+ (* 0.5 pi) (angle pt1 pt2)) (* 0.2 dist)) (polar pt1 (+ (* 0.5 pi) (angle pt2 pt1)) (* 0.2 dist))))
(command "dimaligned" pt1 pt2 (polar pt1 (+ (* 0.5 pi) (angle pt1 pt2)) (* 0.2 dist))))
    )
    ((= (cdr (assoc 0 (entget en))) "ARC")
    (setq pt1 (vlax-curve-getStartPoint (vlax-ename->vla-object en))
          pt2 (vlax-curve-getEndPoint (vlax-ename->vla-object en))
          dist (vla-get-arclength (vlax-ename->vla-object en))
   )
      (command "dimangular"  pt "t" (rtos dist 2 2)
               (if (> bu 0) (polar pt1 (+ (* 0.5 pi) (angle pt1 pt2)) (* 0.2 dist)) (polar pt1 (+ (* 0.5 pi) (angle pt2 pt1)) (* 0.2 dist))))
    )
   )
       dist
       )
  )

clh521

谢谢，完美解决了我问题，试用了一下，感觉不错！

yaokui25

这个很实用