动态引线标注（改版）

爱汉阳造

好神奇，这么多牛人

levmne

不错的东西，收藏了

布朗运动

新年快乐！不如再接再励继续改进一下：编辑文字后引线长度自动跟随文字长度变化！

Bellahx

布朗运动 发表于 2015-1-1 17:27
新年快乐！不如再接再励继续改进一下：编辑文字后引线长度自动跟随文字长度变化！

这个需要做反应器，曾经尝试写过，可以看我发的帖子，有贴源码。集体移动的时候会有问题。

布朗运动

Bellahx 发表于 2015-2-2 10:04
这个需要做反应器，曾经尝试写过，可以看我发的帖子，有贴源码。集体移动的时候会有问题。

继续请教：
1、反应器多了的话会不会影响CAD运行速度？
2、图名下往往带下划线，这个可不可以加个反应器，这样的话图名修改后下面的下划线自动进行长度调整。
3、我的部分图纸使用的快速引线出了很奇怪的问题，不知道和您说的“集体移动的时候会有问题”是不是有类似之处，如有兴趣，请移步至：http://bbs.mjtd.com/thread-112861-1-1.html（匪夷所思的快速引线复制问题（谁看了谁说怪））查看详情。

Bellahx

布朗运动 发表于 2015-2-2 11:27
继续请教：
1、反应器多了的话会不会影响CAD运行速度？
2、图名下往往带下划线，这个可不可以加个反应器 ...

1: 以前好像看过一个帖子里说反应器多了会影响速度，想想也是这样，不过没有测试过。不知道有没有人来解释一下~
2：http://bbs.mjtd.com/thread-109731-1-1.html  这个里面贴了一个带反应器的写图名程序，有些问题也在里面贴出来了，请教了几个大牛，不过一直也没修改好。
3：表示一直搞不明白cad的引线(⊙o⊙)…从来都是自己动手\(^o^)/~

Bellahx

布朗运动 发表于 2015-2-2 11:27
继续请教：
1、反应器多了的话会不会影响CAD运行速度？
2、图名下往往带下划线，这个可不可以加个反应器 ...

补充一下，针对你说的标题问题，我觉得反应器并不是一个好的选择。反应器的连接在复制删除时候经常处理不够恰当，容易出错。
我写了一个小程序，直接选择标题以及下面的两条线（选一条或者不选也可以，会自动添加），就可以自动调整线条长度以及距离，有兴趣可以试一下。

1. ;;;  =================================================;;;   标题修改
   
2. ;;;   修改标题与下划线的相关距离
   
3. ;;;   默认距离为1mm，按当前字高与3.5比例确定比例
   
4. ;;;   字为白色，上面线为蓝色，下面为绿色。
   
5. ;;;   注：必须选择文字，直线可选0-2条，少线自动补。
   
6. ;;;   多行文字问题未处理。
   
7. ;;;   作者：Isabellalhx      命令:ConnectLineToText (CCT)        日期:2014年3月
   
8. ;;;  =================================================
   
9. (defun C:CCT ()
   
10.     (defun *error* (msg)
    
11.         (setvar "cmdecho" cmdecho) ;_ 恢复cmdecho系统变量
    
12.         (setvar "osmode" TemOsMode) ;_ 恢复osmode系统变量
    
13.         (princ "error: ")
    
14.         (princ msg) ;_ 打印错误信息
    
15.         (princ)
    
16.     )
    
17.     (setq cmdecho (getvar "cmdecho")) ;_ 保存系统变量cmdecho值
    
18.     (setvar "cmdecho" 0) ;_ 关闭命令行的回显提示
    
19.     (setq TemOsMode (getvar "osmode"))        ;记录对象捕捉当前值
    
20.     ;;(setvar "osmode" 0)                        ;设为不捕捉
    
21.     (vl-load-com)                        ;加载ActiveX
    
22.                                         ;(command "(vl-load-com)")
    
23. 
    
24.     (setvar "cmdecho" 0)                ;设置cad自带命令不显示提示
    
25.                                         ;  (setq $orr *error*)
    
26.                                         ;  (setq *error* #erryx001)
    
27.     (command ".UNDO" "BE")
    
28.     (setq Scale              (getvar "DIMSCALE") ;缩放比例（取当前标注比例）
    
29.           TitleHeight 3.5                ;标题高3.5
    
30.           TextHeight  2.5                ;普通标注高2.5
    
31.           TextOff     0.625                ;偏移标准值
    
32.     )
    
33.     (setq OS# (getvar "osmode"))        ;标记当前对象捕捉状态
    
34.     (setvar "osmode" 0)                        ;设置对象捕捉为0
    
35.     ;;***********读入标题与直线*********************************
    
36.     (prompt "请选择标题(最多可包括两条直线):")
    
37.     (terpri)
    
38.     (setq Elements (ssget '((0 . "LINE,TEXT,MTEXT"))))
    
39.     (setq TotEle (sslength Elements))
    
40.     (if        (and (< TotEle 4) (> TotEle 0))
    
41.         ;;需要少于3个
    
42.         (progn
    
43.             (setq TitleFlag 0)
    
44.             (setq LineFlag 0)
    
45.             (setq i 0)
    
46.             (setq LineList ())
    
47.             (repeat TotEle
    
48.                 (setq Ele (ssname Elements i))
    
49.                 (setq Ele (entget Ele))
    
50.                 (setq Typ (cdr (assoc 0 Ele)))
    
51.                 (if (= Typ "LINE")
    
52.                     (progn
    
53.                         (setq LineFlag (+ LineFlag 1))
    
54.                         (setq LineList (cons Ele LineList))
    
55.                     )                        ;progn
    
56.                 )                        ;if
    
57.                 (if (or (= Typ "TEXT") (= Typ "MTEXT"))
    
58.                     (progn
    
59.                         (setq TitleFlag (+ TitleFlag 1))
    
60.                         (setq Title Ele)
    
61.                     )                        ;progn
    
62.                 )                        ;if
    
63. 
    
64.                 (setq i (+ i 1))
    
65.             )                                ;repeat
    
66.             (if        (= TitleFlag 1)
    
67.                 (progn
    
68.                     ;;***********计算标题比例及所需点坐标*******************
    
69.                     ;;(setq Title (entget Title))
    
70.                     (setq TextPoint (cdr (assoc 10 Title)))
    
71.                     (setq Height  (cdr (assoc 40 Title))
    
72.                           Scale          (/ Height 3.5)
    
73.                           ;;3.5为标题高
    
74.                           TextOff 0.625
    
75.                     )
    
76.                     (setq Width        (+ (caadr (textbox Title))
    
77.                                    (* Scale TextOff)
    
78.                                 )
    
79.                     )
    
80.                     (setq StartPoint1
    
81.                              (polar TextPoint (* 1.25 pi) (* Scale TextOff))
    
82.                     )
    
83.                     (setq StartPoint1
    
84.                              (polar StartPoint1
    
85.                                     (* -0.5 pi)
    
86.                                     (* Scale TextOff)
    
87.                              )
    
88.                     )
    
89.                     (setq EndPoint1
    
90.                              (polar StartPoint1
    
91.                                     0
    
92.                                     (+ Width (* Scale TextOff))
    
93.                              )
    
94.                     )
    
95.                     (setq StartPoint2
    
96.                              (polar StartPoint1 (* -0.5 pi) (* Scale 1))
    
97.                     )
    
98.                     (setq EndPoint2
    
99.                              (polar EndPoint1
    
100.                                     (* -0.5 pi)
     
101.                                     (* Scale 1)
     
102.                              )
     
103.                     )
     
104.                     ;;***********计算标题比例及所需点坐标*******************
     
105.                     ;;(setq LineNum (sslength LineList))
     
106.                     (if        (= LineFlag 0)
     
107.                         (progn
     
108.                             (command "LINE" StartPoint1 EndPoint1 "")
     
109.                             (setq Line1 (entlast))
     
110.                             (command "LINE" StartPoint2 EndPoint2 "")
     
111.                             (setq Line2 (entlast))
     
112.                             (setq Line1 (entget Line1))
     
113.                             (setq Line2 (entget Line2))
     
114.                             (setq LineList (list Line1 Line2))
     
115.                         )                ;progn
     
116.                         (if (= LineFlag 1)
     
117.                             (progn
     
118.                                 (command "LINE"
     
119.                                          StartPoint1
     
120.                                          EndPoint1
     
121.                                          ""
     
122.                                 )
     
123.                                 (setq Line1 (entlast))
     
124.                                 (setq Line1 (entget Line1))
     
125.                                 (setq LineList (cons Line1 LineList))
     
126.                             )                ;progn
     
127.                         )                ;if
     
128. 
     
129.                     )
     
130.                     (setq old (assoc 62 Title))
     
131.                     (setq new '(62 . 7))
     
132.                     (if        (= old nil)
     
133.                         (setq Title (cons new Title))
     
134. ;;;将字换成白色
     
135.                         (setq Title (subst new old Title))
     
136.                     )                        ;if
     
137.                     ;(setq old (assoc 72 Title))
     
138.                     ;(setq new '(72 . 1))
     
139.                     ;(setq Title (subst new old Title))
     
140.                     (entmod Title)
     
141. 
     
142.                     (setq Line1 (car LineList))
     
143.                     (setq Line2 (cadr LineList))
     
144.                     ;;***************将两条直线分别修改属性***************
     
145.                     (setq Line1        (subst (vl-list* 10 StartPoint1)
     
146.                                        (assoc 10 Line1)
     
147.                                        Line1
     
148.                                 )
     
149.                     )
     
150.                     (setq Line1        (subst (vl-list* 11 EndPoint1)
     
151.                                        (assoc 11 Line1)
     
152.                                        Line1
     
153.                                 )
     
154.                     )                        ;改坐标
     
155.                     (setq old (assoc 62 Line1))
     
156.                     (setq new '(62 . 5))
     
157.                     (if        (= old nil)
     
158.                         (setq Line1 (cons new Line1))
     
159.                         (setq Line1 (subst new old Line1))
     
160.                     )                        ;换颜色
     
161. 
     
162.                     (entmod Line1)
     
163.                     ;;表示接受修改
     
164.                     (setq Line2        (subst (vl-list* 10 StartPoint2)
     
165.                                        (assoc 10 Line2)
     
166.                                        Line2
     
167.                                 )
     
168.                     )
     
169.                     (setq Line2        (subst (vl-list* 11 EndPoint2)
     
170.                                        (assoc 11 Line2)
     
171.                                        Line2
     
172.                                 )
     
173.                     )                        ;改坐标
     
174.                     (setq old (assoc 62 Line2))
     
175.                     (setq new '(62 . 3))
     
176.                     (if        (= old nil)
     
177.                         (setq Line2 (cons new Line2))
     
178.                         (setq Line2 (subst new old Line2))
     
179.                     )
     
180.                     (entmod Line2)
     
181. 
     
182. 
     
183.                     ;;**********************************************************未完成
     
184.                 )                        ;progn
     
185.                 (prompt "未选择文字!")
     
186.             )                                ;if
     
187.         )                                ;progn
     
188.         (progn
     
189.             (prompt "选择多余3个!")
     
190.             (terpri)
     
191.         )
     
192.     )                                        ;if
     
193.     (setvar "cmdecho" cmdecho) ;_ 恢复cmdecho系统变量
     
194.     (setvar "osmode" TemOsMode) ;_ 恢复osmode系统变量
     
195. )
     

;;;  =================================================;;;   标题修改 <br /> ;;;   修改标题与下划线的相关距离<br /> ;;;   默认距离为1mm，按当前字高与3.5比例确定比例<br /> ;;;   字为白色，上面线为蓝色，下面为绿色。<br /> ;;;   注：必须选择文字，直线可选0-2条，少线自动补。<br /> ;;;   多行文字问题未处理。<br /> ;;;   作者：Isabellalhx      命令:ConnectLineToText (CCT)        日期:2014年3月<br /> ;;;  =================================================<br /> (defun C:CCT ()<br />     (defun *error* (msg)<br />         (setvar "cmdecho" cmdecho) ;_ 恢复cmdecho系统变量<br />         (setvar "osmode" TemOsMode) ;_ 恢复osmode系统变量<br />         (princ "error: ")<br />         (princ msg) ;_ 打印错误信息<br />         (princ)<br />     )<br />     (setq cmdecho (getvar "cmdecho")) ;_ 保存系统变量cmdecho值<br />     (setvar "cmdecho" 0) ;_ 关闭命令行的回显提示<br />     (setq TemOsMode (getvar "osmode"))        ;记录对象捕捉当前值<br />     ;;(setvar "osmode" 0)                        ;设为不捕捉<br />     (vl-load-com)                        ;加载ActiveX<br />                                         ;(command "(vl-load-com)")<br /> <br />     (setvar "cmdecho" 0)                ;设置cad自带命令不显示提示<br />                                         ;  (setq $orr *error*)<br />                                         ;  (setq *error* #erryx001)<br />     (command ".UNDO" "BE")<br />     (setq Scale              (getvar "DIMSCALE") ;缩放比例（取当前标注比例）<br />           TitleHeight 3.5                ;标题高3.5<br />           TextHeight  2.5                ;普通标注高2.5<br />           TextOff     0.625                ;偏移标准值<br />     )<br />     (setq OS# (getvar "osmode"))        ;标记当前对象捕捉状态<br />     (setvar "osmode" 0)                        ;设置对象捕捉为0<br />     ;;***********读入标题与直线*********************************<br />     (prompt "请选择标题(最多可包括两条直线):")<br />     (terpri)<br />     (setq Elements (ssget '((0 . "LINE,TEXT,MTEXT"))))<br />     (setq TotEle (sslength Elements))<br />     (if        (and (< TotEle 4) (> TotEle 0))<br />         ;;需要少于3个<br />         (progn<br />             (setq TitleFlag 0)<br />             (setq LineFlag 0)<br />             (setq i 0)<br />             (setq LineList ())<br />             (repeat TotEle<br />                 (setq Ele (ssname Elements i))<br />                 (setq Ele (entget Ele))<br />                 (setq Typ (cdr (assoc 0 Ele)))<br />                 (if (= Typ "LINE")<br />                     (progn<br />                         (setq LineFlag (+ LineFlag 1))<br />                         (setq LineList (cons Ele LineList))<br />                     )                        ;progn<br />                 )                        ;if<br />                 (if (or (= Typ "TEXT") (= Typ "MTEXT"))<br />                     (progn<br />                         (setq TitleFlag (+ TitleFlag 1))<br />                         (setq Title Ele)<br />                     )                        ;progn<br />                 )                        ;if<br /> <br />                 (setq i (+ i 1))<br />             )                                ;repeat<br />             (if        (= TitleFlag 1)<br />                 (progn<br />                     ;;***********计算标题比例及所需点坐标*******************<br />                     ;;(setq Title (entget Title))<br />                     (setq TextPoint (cdr (assoc 10 Title)))<br />                     (setq Height  (cdr (assoc 40 Title))<br />                           Scale          (/ Height 3.5)<br />                           ;;3.5为标题高<br />                           TextOff 0.625<br />                     )<br />                     (setq Width        (+ (caadr (textbox Title))<br />                                    (* Scale TextOff)<br />                                 )<br />                     )<br />                     (setq StartPoint1<br />                              (polar TextPoint (* 1.25 pi) (* Scale TextOff))<br />                     )<br />                     (setq StartPoint1<br />                              (polar StartPoint1<br />                                     (* -0.5 pi)<br />                                     (* Scale TextOff)<br />                              )<br />                     )<br />                     (setq EndPoint1<br />                              (polar StartPoint1<br />                                     0<br />                                     (+ Width (* Scale TextOff))<br />                              )<br />                     )<br />                     (setq StartPoint2<br />                              (polar StartPoint1 (* -0.5 pi) (* Scale 1))<br />                     )<br />                     (setq EndPoint2<br />                              (polar EndPoint1<br />                                     (* -0.5 pi)<br />                                     (* Scale 1)<br />                              )<br />                     )<br />                     ;;***********计算标题比例及所需点坐标*******************<br />                     ;;(setq LineNum (sslength LineList))<br />                     (if        (= LineFlag 0)<br />                         (progn<br />                             (command "LINE" StartPoint1 EndPoint1 "")<br />                             (setq Line1 (entlast))<br />                             (command "LINE" StartPoint2 EndPoint2 "")<br />                             (setq Line2 (entlast))<br />                             (setq Line1 (entget Line1))<br />                             (setq Line2 (entget Line2))<br />                             (setq LineList (list Line1 Line2))<br />                         )                ;progn<br />                         (if (= LineFlag 1)<br />                             (progn<br />                                 (command "LINE"<br />                                          StartPoint1<br />                                          EndPoint1<br />                                          ""<br />                                 )<br />                                 (setq Line1 (entlast))<br />                                 (setq Line1 (entget Line1))<br />                                 (setq LineList (cons Line1 LineList))<br />                             )                ;progn<br />                         )                ;if<br /> <br />                     )<br />                     (setq old (assoc 62 Title))<br />                     (setq new '(62 . 7))<br />                     (if        (= old nil)<br />                         (setq Title (cons new Title))<br /> ;;;将字换成白色<br />                         (setq Title (subst new old Title))<br />                     )                        ;if<br />                     ;(setq old (assoc 72 Title))<br />                     ;(setq new '(72 . 1))<br />                     ;(setq Title (subst new old Title))<br />                     (entmod Title)<br /> <br />                     (setq Line1 (car LineList))<br />                     (setq Line2 (cadr LineList))<br />                     ;;***************将两条直线分别修改属性***************<br />                     (setq Line1        (subst (vl-list* 10 StartPoint1)<br />                                        (assoc 10 Line1)<br />                                        Line1<br />                                 )<br />                     )<br />                     (setq Line1        (subst (vl-list* 11 EndPoint1)<br />                                        (assoc 11 Line1)<br />                                        Line1<br />                                 )<br />                     )                        ;改坐标<br />                     (setq old (assoc 62 Line1))<br />                     (setq new '(62 . 5))<br />                     (if        (= old nil)<br />                         (setq Line1 (cons new Line1))<br />                         (setq Line1 (subst new old Line1))<br />                     )                        ;换颜色<br /> <br />                     (entmod Line1)<br />                     ;;表示接受修改<br />                     (setq Line2        (subst (vl-list* 10 StartPoint2)<br />                                        (assoc 10 Line2)<br />                                        Line2<br />                                 )<br />                     )<br />                     (setq Line2        (subst (vl-list* 11 EndPoint2)<br />                                        (assoc 11 Line2)<br />                                        Line2<br />                                 )<br />                     )                        ;改坐标<br />                     (setq old (assoc 62 Line2))<br />                     (setq new '(62 . 3))<br />                     (if        (= old nil)<br />                         (setq Line2 (cons new Line2))<br />                         (setq Line2 (subst new old Line2))<br />                     )<br />                     (entmod Line2)<br /> <br /> <br />                     ;;**********************************************************未完成 <br />                 )                        ;progn<br />                 (prompt "未选择文字!")<br />             )                                ;if<br />         )                                ;progn<br />         (progn<br />             (prompt "选择多余3个!")<br />             (terpri)<br />         )<br />     )                                        ;if<br />     (setvar "cmdecho" cmdecho) ;_ 恢复cmdecho系统变量<br />     (setvar "osmode" TemOsMode) ;_ 恢复osmode系统变量<br /> )<br />

布朗运动

Bellahx 发表于 2015-2-3 10:50
补充一下，针对你说的标题问题，我觉得反应器并不是一个好的选择。反应器的连接在复制删除时候经常处理不 ...

没想到您早就考虑过这个问题了。程序（CCT）很方便，不过有个小问题建议修正一下：图中有一个文字，文字下方有一条直线，启动cct，同时选中文字和直线，确定，文字下方会出现两条重合的直线。

Bellahx

布朗运动 发表于 2015-2-3 13:06
没想到您早就考虑过这个问题了。程序（CCT）很方便，不过有个小问题建议修正一下：图中有一个文字，文字下 ...

多谢指正 代码已经跟新过~应该没有那个问题啦~

汕阳小居

不知道能不能改为指定到某个图层？还有，如果想修改为指定一种字体而不是当前字体。该怎么办呢？！