批量通过文本内容选择与之平行的线

279491611

1.批量通过文本内容选择与之平行的线 （如：文字内容为7 就选择 与 7 角度大致相同的 7 附近的线）
2.把选择到的线和文字改成 同一种 颜色或 同一 图层 图层名 为文本内容。
3.如果更进一步 ，把这个文本 与 这一根线做成一个块就更完美了，块名 就以文本内容_加流水号。
（文件特点：1 . 文本 与 直线一 一 对应                    2. 直线始终位于文本下方
                    3. 直线相交处必有断点.

q3_2006

2. (defun c:tt ( / ang b box col doc ent i lay layobj ll pm pp sl ss str th ur)
   
3.   (vl-load-com)
   
4.   (command "chprop" "all" "" "lt" "continuous" "")
   
5.   (setq ss (ssget '((0 . "mtext,text"))) i -1)
   
6.     (while (setq ent (ssname ss (setq i (1+ i))))
   
7.       (setq b (vlax-ename->vla-object ent)
   
8.         ang (vla-get-Rotation b)
   
9.         str (vla-get-TextString b)
   
10.         th (vla-get-Height b)
    
11.         lay (vla-get-layer b)
    
12.         col (vla-get-color b)
    
13.       )
    
14.   (if (= col 256)
    
15.     (progn
    
16.       (setq doc (vla-get-activedocument (vlax-get-acad-object)))
    
17.       (setq layobj (vla-item (vla-get-layers doc) lay))
    
18.       (setq col (vla-get-color layobj))
    
19.     )
    
20. )
    
21.   (vla-getboundingbox b 'll 'ur)
    
22.   (setq box (mapcar 'vlax-safearray->list (list ll ur))
    
23.     pm (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (car box) (cadr box)))
    
24.     pp (polar pm (- ang (* 0.5 pi)) th)
    
25.     sl (ssname (ssget "f" (list pm pp) '((0 . "line"))) 0)
    
26.   )
    
27.   (Vlax-Put-Property (Vlax-Ename->Vla-Object ent) 'Color str)
    
28.   (Vlax-Put-Property (Vlax-Ename->Vla-Object sl) 'Color str)
    
29. )
    
30.   (command "chprop" "all" "" "lt" "bylayer" "")   
    
31.     )

(defun c:tt ( / ang b box col doc ent i lay layobj ll pm pp sl ss str th ur)<br />   (vl-load-com)<br />   (command "chprop" "all" "" "lt" "continuous" "")<br />   (setq ss (ssget '((0 . "mtext,text"))) i -1)<br />     (while (setq ent (ssname ss (setq i (1+ i))))<br />       (setq b (vlax-ename->vla-object ent)<br />         ang (vla-get-Rotation b)<br />         str (vla-get-TextString b)<br />         th (vla-get-Height b)<br />         lay (vla-get-layer b)<br />         col (vla-get-color b)<br />       )<br />   (if (= col 256)<br />     (progn<br />       (setq doc (vla-get-activedocument (vlax-get-acad-object)))<br />       (setq layobj (vla-item (vla-get-layers doc) lay))<br />       (setq col (vla-get-color layobj))<br />     )<br /> )<br />   (vla-getboundingbox b 'll 'ur)<br />   (setq box (mapcar 'vlax-safearray->list (list ll ur))<br />     pm (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (car box) (cadr box)))<br />     pp (polar pm (- ang (* 0.5 pi)) th)<br />     sl (ssname (ssget "f" (list pm pp) '((0 . "line"))) 0)<br />   )<br />   (Vlax-Put-Property (Vlax-Ename->Vla-Object ent) 'Color str)<br />   (Vlax-Put-Property (Vlax-Ename->Vla-Object sl) 'Color str)<br /> )<br />   (command "chprop" "all" "" "lt" "bylayer" "")    <br />     )

newer

楼主什么专业，这个功能是做什么用的？

附近要是有多根同角度的线呢？ 都做到一起？

279491611

谢谢关注 ，结构，一个文本 对应 一根线，就是一文本就是一种断面，而这根线就是相应的那根杆件. 文本就在这根线的附近（可以设定一个容差），文本的角度，与线的角度也有容差的.

newer

279491611 发表于 2013-12-26 18:32
谢谢关注 ，结构，一个文本 对应 一根线，就是一文本就是一种断面，而这根线就是相应的那根杆件.

也就是说画图时候保证了一个文本附近只有一个角度相近的线了？

newer

还有，你图中的2个7，下面水平的线在交点处都是断开的？不会有2个文字共用一根线的情况？

279491611

是的，这是别的 软件 输出来的图形 。他没把断面用图层或颜色分开。 只能自己判断一 一对应的关系.

st788796

这种图适合用图形的生成顺序直接遍历

279491611

newer 发表于 2013-12-26 18:39
还有，你图中的2个7，下面水平的线在交点处都是断开的？不会有2个文字共用一根线的情况？

那个应该是 2个7对应的两根线 刚好位于同一直线上 。 不会存在 2根线 共一个 文本 或 2个文本共一根线的情况。应是一 一 对应关系.

newer

给你写个，加载XDRX_API,晓东LISP函数库，

1、给你做成块了。
2、块图层到文本名，颜色随文本号

角度精度5度内，合并处理。

需完善请跟帖。

1. (defun c:tt()
   
2.    (prompt "\n选取要处理的文本<退出>:")
   
3.    (if (setq ss (ssget '((0 . "TEXT"))))
   
4.      (progn
   
5.         (XD::Begin)
   
6.         (xdrx_sysvar_push '("osmode" 0))
   
7.         (setq ang-fuzz 5
   
8.               len (sslength ss)
   
9.               i 0
   
10.               j 0
    
11.         )
    
12.         (xdrx_statusbar_begin "处理中" len)
    
13.         (xdrx_setsstodb ss 0)
    
14.         (while (setq e (xdrx_getentdata 0))
    
15.            (setq i (1+ i))
    
16.            (xdrx_statusbar_setpos i)
    
17.            (mapcar 'set '(an pj h txt) (xdrx_getpropertyvalue e "rotation" "position" "height" "textstring"))
    
18.            (setq an (XD::Geom:AngleFormat an))
    
19.            (if (setq ss1 (xdrx_pickset_getAtPoint pj h 9 '((0 . "LINE"))))
    
20.              (progn
    
21.                 (setq ents nil)
    
22.                 (while (setq e1 (xdrx_getentdata 9))
    
23.                    (setq an1 (xdrx_getpropertyvalue e1 "angle")
    
24.                          an1 (XD::Geom:AngleFormat an1)
    
25.                    )
    
26.                    (if (< (- (abs (- an1 an)) (* pi (/ ang-fuzz 180.0))) 1e-5)
    
27.                      (setq ents (cons e1 ents))
    
28.                    )
    
29.                 )
    
30.                 (if ents
    
31.                    (progn
    
32.                       (setq ss2 (XD::Entity->PickSet (list e (car ents))))
    
33.                       (xdrx_entity_setcolor ss2 0)
    
34.                       (xdrx_block_make  (strcat txt "_" (xdrx_getrandstr)(xdrx_getrandstr)(xdrx_getrandstr)) ss2 pj t)
    
35.                       (xdrx_setpropertyvalue (entlast) "color" (atoi txt) "layer" txt)
    
36.                       (setq j (1+ j))
    
37.                    )
    
38.                 )
    
39.              )
    
40.            )
    
41.         )
    
42.         (prompt (strcat "\n处理完毕！，合并了" (itoa j) "个文字和杆件到块."))
    
43.         (xdrx_statusbar_end)
    
44.         (xdrx_sysvar_pop)
    
45.         (XD::End)
    
46.      )
    
47.    )
    
48.    (princ)
    
49. )

(defun c:tt()<br />    (prompt "\n选取要处理的文本<退出>:")<br />    (if (setq ss (ssget '((0 . "TEXT"))))<br />      (progn<br />         (XD::Begin)<br />         (xdrx_sysvar_push '("osmode" 0))<br />         (setq ang-fuzz 5<br />               len (sslength ss)<br />               i 0<br />               j 0<br />         )<br />         (xdrx_statusbar_begin "处理中" len)<br />         (xdrx_setsstodb ss 0)<br />         (while (setq e (xdrx_getentdata 0))<br />            (setq i (1+ i))<br />            (xdrx_statusbar_setpos i)<br />            (mapcar 'set '(an pj h txt) (xdrx_getpropertyvalue e "rotation" "position" "height" "textstring"))<br />            (setq an (XD::Geom:AngleFormat an))<br />            (if (setq ss1 (xdrx_pickset_getAtPoint pj h 9 '((0 . "LINE"))))<br />              (progn<br />                 (setq ents nil)<br />                 (while (setq e1 (xdrx_getentdata 9))<br />                    (setq an1 (xdrx_getpropertyvalue e1 "angle")<br />                          an1 (XD::Geom:AngleFormat an1)<br />                    )<br />                    (if (< (- (abs (- an1 an)) (* pi (/ ang-fuzz 180.0))) 1e-5)<br />                      (setq ents (cons e1 ents))<br />                    )<br />                 )<br />                 (if ents<br />                    (progn<br />                       (setq ss2 (XD::Entity->PickSet (list e (car ents))))<br />                       (xdrx_entity_setcolor ss2 0)<br />                       (xdrx_block_make  (strcat txt "_" (xdrx_getrandstr)(xdrx_getrandstr)(xdrx_getrandstr)) ss2 pj t)<br />                       (xdrx_setpropertyvalue (entlast) "color" (atoi txt) "layer" txt)<br />                       (setq j (1+ j))<br />                    )<br />                 )<br />              )<br />            )<br />         )<br />         (prompt (strcat "\n处理完毕！，合并了" (itoa j) "个文字和杆件到块."))<br />         (xdrx_statusbar_end)<br />         (xdrx_sysvar_pop)<br />         (XD::End)<br />      )<br />    )<br />    (princ)<br /> )

279491611

no function definition: XD::BEGIN

279491611

newer 发表于 2013-12-26 19:39
给你写个，加载XDRX_API,晓东LISP函数库，给你做成块了。
角度精度5度内，合并处理。

谢谢，文字处理好了  2012   x64   加载了 XDRX_API.R18.X64.arx
no function definition: XD::BEGIN

线好像没反应

newer

279491611 发表于 2013-12-26 19:58
谢谢，文字处理好了  2012   x64  
no function definition: XD::BEGIN

去下载 晓东通用LISP函数库，加载它。

看我的签名。

279491611

newer 发表于 2013-12-26 20:07
去下载 晓东通用LISP函数库，加载它。

看我的签名。

谢谢，已经做成一个个的块了。就是线的颜色和图层没有与文本统一，线线修改了位置？ 线和文本位置不必调整。线的位置很重要。文本倒是无所谓。

好像是块的是重名的才会有这个情况，块名称不要相同，即使是同一角度，长度，同一文本，因为他们的位置 或 方向不一样。

可能刚才的图形不够完整。

newer

279491611 发表于 2013-12-26 20:18
谢谢，已经做成一个个的块了。就是线的颜色和图层没有与文本统一，线线修改了位置？ 线和文本位置不必调 ...

改写了程序，重新下载9楼的代码执行看看。

颜色，图层，块都考虑了。

另外请问下：

1、这个图是什么专业软件生成的？
2、图叫什么名？
3、这个工具应该是后处理吧，你做成块后，以后还想操作它吗？做成块有什么好处？


我好去到每日插件发布，确定下分类。