求助 批量在L直线上标注长度

717957265

可以多选用L命令画的直线，然后批量在直线上标注它的长度，能设置文字大小，不要箭头的，标注是文字格式的。斜的直线文字都是斜着向上的。类似图纸这样的。求高手帮忙做个代码。小弟感激不尽。

Andyhon

(command "text"
      "j"
      "bc"
      pt
      ""
      (* (/ ang pi) 180)
      (strcat "" (rtos dd 2))   ;<===
      ""
  )
  
  (strcat "前綴" (rtos dd 2))   ;<===
  (strcat (rtos dd 2) "后綴")   ;<===

bai2000

但是如果直线起点是右边 终点是左边 文字就是倒过来的
太不好用了。
麻烦2楼大大 帮我做一个 谢谢了

fl202

看看我的程序能否解决你的问题：
http://bbs.mjtd.com/thread-176541-1-1.html
见16楼。

Real_King

CAD哪个版本？用net帮你吧

kunki

标注所有线段(加载后只需框选所有线段便可得标注这些线段)
defun c:LLL ()
(COMMAND "UCS" "")
(setvar "cmdecho" 1)
(SETVAR "OSMODE" 0)
(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
    ;;如果是其他种类线条
    (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))
      ""
  )
  (setq i (1+ i))
)
(prin1)
)
(prompt "\n <>在图中直接写出长度")
(prin1)

717957265

Real_King 发表于 2016-5-22 10:50
CAD哪个版本？用net帮你吧

2008版本的 3楼的那个我有 但是如果直线起点是右边 终点是左边 文字就是倒过来的
太不好用了。
麻烦2楼大大 帮我做一个 谢谢了

717957265

kunki 发表于 2016-5-22 13:33
标注所有线段(加载后只需框选所有线段便可得标注这些线段)
defun c:LLL ()
(COMMAND "UCS" "")

这个我有，直线起点是右边 终点是左边 他的标注是倒过来的
根本没法用。
论坛上只能找到这个，o(︶︿︶)o 唉

Real_King

717957265 发表于 2016-5-22 14:20
2008版本的 3楼的那个我有 但是如果直线起点是右边 终点是左边 文字就是倒过来的
太不好用了。
麻烦2楼 ...

我用10的32改64位的CAD...算了，先用这个版本给你搞吧

717957265

Real_King 发表于 2016-5-22 17:50
我用10的32改64位的CAD...算了，先用这个版本给你搞吧

太感谢你了

香田里浪人

论坛里有，仔细找

717957265

香田里浪人 发表于 2016-5-23 08:14
论坛里有，仔细找

论坛里的就是3楼给的 不是很好用

香田里浪人