仲文玉 发表于 2012-8-6 14:36:33

标注线段长度【文字方式】

本帖最后由 仲文玉 于 2012-8-11 08:30 编辑


(defun C:kxbz ()
(COMMAND "UCS" "")
(setq cmdecho_bak (getvar "cmdecho"))
(setq AcadObject   (vlax-get-acad-object)
AcadDocument (vla-get-ActiveDocument Acadobject)
mSpace      (vla-get-ModelSpace Acaddocument)
)
;;选取需要测量的样条曲线、圆弧、直线、椭圆
(setq en (ssget (list '(0 . "spline,arc,line,ellipse,LWPOLYLINE"))))
(setq i 0)
;;获取系统参数textsize
(setq shh (getvar "textsize"))
(setq str_hh (strcat "\n文字高度 <" (rtos shh 2) ">: "))
(setq hh (getdist str_hh))
(while hh
    (setvar "textsize" hh)
    (setq hh nil)
)
;;输入标注文字高度
;;循环开始
(repeat (sslength en)
    (setq ss (ssname en i))
    (setq endata (entget ss))
    (command "lengthen" ss "")
    (setq dd (getvar "perimeter"))
    (princ (strcat "\n长度=" (rtos dd 2)))
    ;;寻找代表图层的字符串
    (setq aa (assoc 0 endata))
    ;;获取图层名称
    (setq aa1 (cdr aa))
    ;;判断线条种类
    (cond
      ((= aa1 "SPLINE")
       ;;如果是spline
       (progn
(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
(setq startPnt1 (vla-get-ControlPoints arcObj))
(setq p1
(vlax-safearray->list (vlax-variant-value startPnt1))
)
(setq x1 (car p1))
(setq y1 (cadr p1))
(setq z1 (caddr p1))
(setq pp1 (list x1 y1 z1))
(repeat (- (/ (length p1) 3) 1)
    ;;循环，寻找最后一个控制点
    (setq p1 (cdddr p1))
    (setq x2 (car p1))
    (setq y2 (cadr p1))
    (setq z2 (caddr p1))
)
(setq pp2 (list x2 y2 z2))
       )
      )
      ((= aa1 "LWPOLYLINE")
       ;;如果是LWPOLYLINE
       (progn
(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
(setq startPnt1 (vla-get-Coordinates arcObj))
(setq p1 (vlax-safearray->list (vlax-variant-value startPnt1)))
(setq x1 (car p1))
(setq y1 (cadr p1))
(setq z1 (caddr p1))
(setq pp1 (list x1 y1 z1))
(repeat (- (/ (length p1) 3) 1)
    ;;循环，寻找最后一个控制点
    (setq p1 (cdddr p1))
    (setq x2 (car p1))
    (setq y2 (cadr p1))
    (setq z2 (caddr p1))
)
(setq pp2 (list x2 y2 z2))
       )
      )
      (t
       (princ)
       ;;如果是其他种类线条
       (progn
(setq arcObj (VLAX-ENAME->VLA-OBJECT ss))
(setq startPnt1 (vla-get-StartPoint arcObj))
;;获取起点
(setq endPnt1 (vla-get-EndPoint arcObj))
;;获取终点
(setq pp1
(vlax-safearray->list (vlax-variant-value startPnt1))
)
(setq
    pp2 (vlax-safearray->list (vlax-variant-value endPnt1))
)
       )
      )
    )
    (setq x1 (car pp1))
    (setq y1 (cadr pp1))
    (setq z1 (caddr pp1))
    (setq x2 (car pp2))
    (setq y2 (cadr pp2))
    (setq z2 (caddr pp2))
    (setq x (/ (+ x1 x2) 2))
    (setq y (/ (+ y1 y2) 2))
    (setq z (/ (+ z1 z2) 2))
    (setq pt (list x y z))
    ;;取得线段两端的中点
    (setq ang (angle pp1 pp2))
    ;;获取角度
    (if (> (* (/ ang pi) 180) 180)
      (setq ang (+ ang pi))
    )
    (command "text"
      "j"
      "bc"
      pt
      ""
      (* (/ ang pi) 180)
      (strcat "" (rtos dd 2))
    )
    (princ)
    (setq i (1+ i))
)
(princ)
(setvar "cmdecho" cmdecho_bak)
(princ)
)

lxl217114 发表于 2020-8-20 14:00:45

香田里浪人 发表于 2014-12-6 17:51
;;;多义线边长标注
(defun HH:Remove (en / NEWDATA)
(foreach e (entget en)


Auto CAD 2020 正常使用，但是会乱码

ccc230 发表于 2020-9-7 20:28:13

我是win10 64位CAD2010 错误: 输入的字符串有缺陷，班主咋搞呢

zfsaaa 发表于 2022-5-25 10:07:09

有无让标注文字别跑那么远的修改编码？

仲文玉 发表于 2012-8-6 14:38:27

本帖最后由 仲文玉 于 2012-8-6 14:39 编辑

忘了备注作者信息，代码版权归原作者所有；鉴于很多会员们需要，贴出来，见谅

haoryh 发表于 2012-8-6 14:43:19

老大这个利害！多谢了！

GamIng 发表于 2012-8-6 14:44:05

多谢版主！好东西，收藏了！

xyp1964 发表于 2012-8-6 16:38:30

preone 发表于 2012-8-6 19:10:41

这个 必须顶~~

461045462 发表于 2012-8-6 21:09:17

谢谢斑竹的分享！
收藏了。
谢谢！

xsso 发表于 2012-8-6 21:42:01

为什么我试用的时候，除了椭圆，其它的标设都乱飞到一边去

xsso 发表于 2012-8-6 21:46:02

而且程序头部少了(vl-load-com)，建议补充或者加上

bai2000 发表于 2012-8-7 10:17:49

标注乱发，楼主调整一下
页: [1] 2 3 4 5 6
查看完整版本: 标注线段长度【文字方式】