文字碰撞程序求优化

xiaomm250

如果文字或者标注里面的文字, 如果有碰撞,
则圈出来他们,感觉速度不行,求优化速度!
基本的算法原理,源代码里面有!

2. ;获得标注中的多行文字的文字框的坐标, 返回四个点组成的list (包含中心点, 直径*0.6),默认对齐方式71 是5
   
3. ;(entget ssn)
   
4. (defun getdimlist(ssn / ABC ABCNAME ABCNAMEDATA GD ITTYPE KD KKK PT10 PTA PTB PTC PTD ROT )
   
5.     ;获得标注所对应的块名, 通过块名找到块组码, 再找到图元名
   
6.     (setq abc (tblsearch "BLOCK" (cdr(assoc 2 (entget ssn)))))
   
7.     (setq abcname (cdr(assoc -2 abc)))
   
8.     ;通过循环获得标注文字,是多行文字!
   
9.     (setq kkk 8888)
   
10.     (while kkk
    
11.         (if (and
    
12.               (setq ittype (cdr(assoc 0 (entget abcname))))
    
13.               (equal ittype "MTEXT")
    
14.             )
    
15.             (setq kkk nil)
    
16.             (if(setq abcname (entnext abcname))
    
17.               (progn
    
18.                   (setq ittype (cdr(assoc 0 (entget abcname))))
    
19.                   (if (equal ittype "MTEXT")
    
20.                       (setq kkk nil)
    
21.                   )
    
22.               )
    
23.             )
    
24.         )
    
25.     )
    
26.     ;找到了多行文字, 现在要求返回坐标, 先找到插入点, 宽度\高度
    
27.     (setq abcnamedata (entget abcname))
    
28.     (setq pt10(cdr(assoc 10 abcnamedata)));插入点
    
29.     (setq kd  (cdr(assoc 42 abcnamedata)))
    
30.     (setq gd  (cdr(assoc 43 abcnamedata)))
    
31.     (setq rot (cdr(assoc 50 abcnamedata)))
    
32.     (setq pta (polar(polar pt10 rot (* 0.5 kd))(+ rot(* 0.5 pi))(* 0.5 gd)))
    
33.     (setq ptb (polar pta (+ rot pi)kd))
    
34.     (setq ptc (polar ptb (+ rot (* 1.5 pi))gd))
    
35.     (setq ptd (polar ptc rot kd))
    
36.     (list pta ptb ptc ptd pt10 (* 0.6 (distance pta ptc)))
    
37. )
    
38. ;获得单行文字的包围坐标,中心点,半径
    
39. (defun gettextlist(ssn / GD KD KDGD PT10 PTA PTB PTC PTD ROT SSDATA)
    
40.   (setq ssdata (entget ssn))
    
41.   (setq kdgd (nth 1 (textbox ssdata)))
    
42.   (setq kd (nth 0 kdgd))
    
43.   (setq gd (nth 1 kdgd))
    
44.   (setq pta (cdr(assoc 10 ssdata)))
    
45.   (setq rot (cdr(assoc 50 ssdata)))
    
46.   (setq ptb (polar pta rot kd))
    
47.   (setq ptc (polar ptb (+ rot (* 0.5 pi))gd))
    
48.   (setq ptd (polar ptc (+ rot (* 1.0 pi))kd))
    
49.   (setq pt10 (mapcar(function(lambda(x y)(* 0.5 (+ x y))))pta ptc))
    
50.   (list pta ptb ptc ptd pt10 (* 0.6 (distance pta ptc)))
    
51. )
    
52. 
    
53. ;主要程序, 检查文字碰撞, 如果有碰撞,则包围圈
    
54. ;基本思路:先通过找文字与尺寸标注里面的文字, 然后找到包围文字的四边形,再通过四边形选择四边形,如果
    
55. ;四边形的个数大于1,则表示文字有碰撞,否则文字不碰撞.
    
56. (defun c:tt( / ENTYPE I PT1 PT2 PT3 PT4 PTABCD PTBJ PTCENTER PTLIST SS SS2 SSA SSB SSDATA SSN TCACOLOR TCANAME)
    
57.   (prompt"\n检查标注文字以及文字碰撞,碰撞则单独一个图层画圆圈出来!")
    
58.   (if(and(setq ss (ssget(list
    
59.                             (cons -4 "<OR")
    
60.                                 (cons 0 "TEXT,DIMENSION")
    
61.                                 (cons -4 "<AND")
    
62.                                     (cons 0 "LWPOLYLINE")
    
63.                                     (cons 8 "CGM_REC_")
    
64.                                     (cons 90 4)
    
65.                                     (cons 62 44)
    
66.                                     (cons 70 1)
    
67.                                 (cons -4 "AND>")
    
68.                                 (cons -4 "<AND")
    
69.                                     (cons 0 "LWPOLYLINE")
    
70.                                     (cons 8 "CGM_重叠矩形")
    
71.                                     (cons 90 4)
    
72.                                     (cons 62 1)
    
73.                                     (cons 70 1)
    
74.                                 (cons -4 "AND>")
    
75.                             (cons -4 "OR>")
    
76.                         )))
    
77.          (or
    
78.              (setq i -1 ssa (ssadd) ssb (ssadd))
    
79.              (repeat(sslength ss)
    
80.                  (setq i (1+ i))
    
81.                  (setq ssn (ssname ss i))
    
82.                  (setq entype (cdr(assoc 0 (entget ssn))))
    
83.                  (if(equal entype "LWPOLYLINE")
    
84.                      (setq ssb (ssadd ssn ssb))
    
85.                      (setq ssa (ssadd ssn ssa))
    
86.                  )
    
87.              )
    
88.              (setq ss ssa)
    
89.              (if(>(sslength ssb)0)(command"_ERASE" ssb ""))
    
90.              T
    
91.          )
    
92.      )
    
93.     (progn
    
94.       (setq i -1)
    
95.       (setq tcaname "CGM_REC_" tcacolor 44)
    
96.       (repeat(sslength ss)
    
97.         (setq i (1+ i))
    
98.         (setq ssn (ssname ss i))
    
99.         (setq ssdata (entget ssn))
    
100.         (if (equal(cdr(assoc 0 ssdata))"TEXT")
     
101.           (setq ptlist (gettextlist ssn))
     
102.           (setq ptlist (getdimlist ssn))
     
103.         )
     
104.         (setq pt1 (nth 0 ptlist))
     
105.         (setq pt2 (nth 1 ptlist))
     
106.         (setq pt3 (nth 2 ptlist))
     
107.         (setq pt4 (nth 3 ptlist))
     
108.         (setq ptabcd (list pt1 pt2 pt3 pt4)
     
109.               ptcenter (nth 4 ptlist)
     
110.               ptbj     (nth 5 ptlist)
     
111.         )
     
112.         (makerec pt1 pt2 pt3 pt4 tcaname tcacolor)
     
113.       );repeat
     
114.       ;通过多段线选择,看选择到的多段线的个数是否大于1,大于1则重叠!
     
115.       (if(setq ss (ssget"X"(list
     
116.                             (cons 0 "LWPOLYLINE")
     
117.                             (cons 8 tcaname)
     
118.                             (cons 90 4)
     
119.                             (cons 62 tcacolor)
     
120.                             (cons 70 1)
     
121.                         )))
     
122.         (progn
     
123.           (setq i -1)
     
124.           (repeat(sslength ss)
     
125.             (setq i (1+ i))
     
126.             (setq ssdata (entget(ssname ss i)))
     
127.             (setq ptlist (mapcar 'cdr (vl-remove-if(function(lambda(x)(/=(car x)10)))ssdata)))
     
128.             (if (and
     
129.                   (setq ss2 (ssget "CP" ptlist (list
     
130.                                                     (cons 0 "LWPOLYLINE")
     
131.                                                     (cons 8 tcaname)
     
132.                                                     (cons 90 4)
     
133.                                                     (cons 62 tcacolor)
     
134.                                                     (cons 70 1)
     
135.                                                )))
     
136.                   (>(sslength ss2)1)
     
137.                 )
     
138.               (progn
     
139.                   (makerec (nth 0 ptlist) (nth 1 ptlist) (nth 2 ptlist) (nth 3 ptlist) "CGM_重叠矩形" 1)
     
140.               )
     
141.             )
     
142.           );repeat
     
143.           (command"_ERASE" ss "")
     
144.         )
     
145.       );if
     
146.     )
     
147.   )
     
148. )
     
149. 
     
150. ;生成矩形多段线,用来被判定!
     
151. (defun makerec(pt1 pt2 pt3 pt4 tcname tccolor / )
     
152.     (entmake
     
153.       (list
     
154.           (cons 0 "LWPOLYLINE")
     
155.           (cons 100 "AcDbEntity")
     
156.           (cons 67 0)
     
157.           (cons 410 "Model")
     
158.           (cons 8 tcname)
     
159.           (cons 100 "AcDbPolyline")
     
160.           (cons 90 4)
     
161.           (cons 62 tccolor)
     
162.           (cons 70 1)
     
163.           (cons 43 0.0)
     
164.           (cons 38 0.0)
     
165.           (cons 39 0.0)
     
166.           (cons 10 pt1)
     
167.           (cons 40 0.0)
     
168.           (cons 41 0.0)
     
169.           (cons 42 0.0)
     
170.           (cons 10 pt2)
     
171.           (cons 40 0.0)
     
172.           (cons 41 0.0)
     
173.           (cons 42 0.0)
     
174.           (cons 10 pt3)
     
175.           (cons 40 0.0)
     
176.           (cons 41 0.0)
     
177.           (cons 42 0.0)
     
178.           (cons 10 pt4)
     
179.           (cons 40 0.0)
     
180.           (cons 41 0.0)
     
181.           (cons 42 0.0)
     
182.           (list 210 0.0 0.0 1.0)
     
183.       )
     
184.     )
     
185. )
     

;获得标注中的多行文字的文字框的坐标, 返回四个点组成的list (包含中心点, 直径*0.6),默认对齐方式71 是5 <br /> ;(entget ssn)<br /> (defun getdimlist(ssn / ABC ABCNAME ABCNAMEDATA GD ITTYPE KD KKK PT10 PTA PTB PTC PTD ROT )<br />     ;获得标注所对应的块名, 通过块名找到块组码, 再找到图元名<br />     (setq abc (tblsearch "BLOCK" (cdr(assoc 2 (entget ssn)))))<br />     (setq abcname (cdr(assoc -2 abc)))<br />     ;通过循环获得标注文字,是多行文字!<br />     (setq kkk 8888)<br />     (while kkk<br />         (if (and <br />               (setq ittype (cdr(assoc 0 (entget abcname))))<br />               (equal ittype "MTEXT")<br />             )<br />             (setq kkk nil)<br />             (if(setq abcname (entnext abcname))<br />               (progn<br />                   (setq ittype (cdr(assoc 0 (entget abcname))))<br />                   (if (equal ittype "MTEXT")<br />                       (setq kkk nil)<br />                   )<br />               )<br />             )<br />         )<br />     )<br />     ;找到了多行文字, 现在要求返回坐标, 先找到插入点, 宽度\高度<br />     (setq abcnamedata (entget abcname))<br />     (setq pt10(cdr(assoc 10 abcnamedata)));插入点<br />     (setq kd  (cdr(assoc 42 abcnamedata)))<br />     (setq gd  (cdr(assoc 43 abcnamedata)))<br />     (setq rot (cdr(assoc 50 abcnamedata)))<br />     (setq pta (polar(polar pt10 rot (* 0.5 kd))(+ rot(* 0.5 pi))(* 0.5 gd)))<br />     (setq ptb (polar pta (+ rot pi)kd))<br />     (setq ptc (polar ptb (+ rot (* 1.5 pi))gd))<br />     (setq ptd (polar ptc rot kd))<br />     (list pta ptb ptc ptd pt10 (* 0.6 (distance pta ptc)))<br /> )<br /> ;获得单行文字的包围坐标,中心点,半径<br /> (defun gettextlist(ssn / GD KD KDGD PT10 PTA PTB PTC PTD ROT SSDATA)<br />   (setq ssdata (entget ssn))<br />   (setq kdgd (nth 1 (textbox ssdata)))<br />   (setq kd (nth 0 kdgd))<br />   (setq gd (nth 1 kdgd))<br />   (setq pta (cdr(assoc 10 ssdata)))<br />   (setq rot (cdr(assoc 50 ssdata)))<br />   (setq ptb (polar pta rot kd))<br />   (setq ptc (polar ptb (+ rot (* 0.5 pi))gd))<br />   (setq ptd (polar ptc (+ rot (* 1.0 pi))kd))<br />   (setq pt10 (mapcar(function(lambda(x y)(* 0.5 (+ x y))))pta ptc))<br />   (list pta ptb ptc ptd pt10 (* 0.6 (distance pta ptc)))<br /> )<br /> <br /> ;主要程序, 检查文字碰撞, 如果有碰撞,则包围圈<br /> ;基本思路:先通过找文字与尺寸标注里面的文字, 然后找到包围文字的四边形,再通过四边形选择四边形,如果<br /> ;四边形的个数大于1,则表示文字有碰撞,否则文字不碰撞.<br /> (defun c:tt( / ENTYPE I PT1 PT2 PT3 PT4 PTABCD PTBJ PTCENTER PTLIST SS SS2 SSA SSB SSDATA SSN TCACOLOR TCANAME)<br />   (prompt"\n检查标注文字以及文字碰撞,碰撞则单独一个图层画圆圈出来!")<br />   (if(and(setq ss (ssget(list<br />                             (cons -4 "<OR")<br />                                 (cons 0 "TEXT,DIMENSION")<br />                                 (cons -4 "<AND")<br />                                     (cons 0 "LWPOLYLINE") <br />                                     (cons 8 "CGM_REC_") <br />                                     (cons 90 4) <br />                                     (cons 62 44) <br />                                     (cons 70 1) <br />                                 (cons -4 "AND>")<br />                                 (cons -4 "<AND")<br />                                     (cons 0 "LWPOLYLINE") <br />                                     (cons 8 "CGM_重叠矩形") <br />                                     (cons 90 4) <br />                                     (cons 62 1) <br />                                     (cons 70 1) <br />                                 (cons -4 "AND>")<br />                             (cons -4 "OR>")<br />                         )))<br />          (or<br />              (setq i -1 ssa (ssadd) ssb (ssadd))<br />              (repeat(sslength ss)<br />                  (setq i (1+ i))<br />                  (setq ssn (ssname ss i))<br />                  (setq entype (cdr(assoc 0 (entget ssn))))<br />                  (if(equal entype "LWPOLYLINE")<br />                      (setq ssb (ssadd ssn ssb))<br />                      (setq ssa (ssadd ssn ssa))<br />                  )<br />              )<br />              (setq ss ssa)<br />              (if(>(sslength ssb)0)(command"_ERASE" ssb ""))<br />              T<br />          )<br />      )<br />     (progn<br />       (setq i -1)<br />       (setq tcaname "CGM_REC_" tcacolor 44)<br />       (repeat(sslength ss)<br />         (setq i (1+ i))<br />         (setq ssn (ssname ss i))<br />         (setq ssdata (entget ssn))<br />         (if (equal(cdr(assoc 0 ssdata))"TEXT")<br />           (setq ptlist (gettextlist ssn))<br />           (setq ptlist (getdimlist ssn))<br />         )<br />         (setq pt1 (nth 0 ptlist))<br />         (setq pt2 (nth 1 ptlist))<br />         (setq pt3 (nth 2 ptlist))<br />         (setq pt4 (nth 3 ptlist))<br />         (setq ptabcd (list pt1 pt2 pt3 pt4)<br />               ptcenter (nth 4 ptlist)<br />               ptbj     (nth 5 ptlist)<br />         )<br />         (makerec pt1 pt2 pt3 pt4 tcaname tcacolor)<br />       );repeat<br />       ;通过多段线选择,看选择到的多段线的个数是否大于1,大于1则重叠!<br />       (if(setq ss (ssget"X"(list<br />                             (cons 0 "LWPOLYLINE") <br />                             (cons 8 tcaname) <br />                             (cons 90 4) <br />                             (cons 62 tcacolor) <br />                             (cons 70 1) <br />                         )))<br />         (progn<br />           (setq i -1)<br />           (repeat(sslength ss)<br />             (setq i (1+ i))<br />             (setq ssdata (entget(ssname ss i)))<br />             (setq ptlist (mapcar 'cdr (vl-remove-if(function(lambda(x)(/=(car x)10)))ssdata)))<br />             (if (and <br />                   (setq ss2 (ssget "CP" ptlist (list <br />                                                     (cons 0 "LWPOLYLINE") <br />                                                     (cons 8 tcaname) <br />                                                     (cons 90 4) <br />                                                     (cons 62 tcacolor) <br />                                                     (cons 70 1) <br />                                                )))<br />                   (>(sslength ss2)1)<br />                 )<br />               (progn<br />                   (makerec (nth 0 ptlist) (nth 1 ptlist) (nth 2 ptlist) (nth 3 ptlist) "CGM_重叠矩形" 1)<br />               )<br />             )<br />           );repeat<br />           (command"_ERASE" ss "")<br />         )<br />       );if<br />     )<br />   )<br /> )<br /> <br /> ;生成矩形多段线,用来被判定!<br /> (defun makerec(pt1 pt2 pt3 pt4 tcname tccolor / )<br />     (entmake<br />       (list<br />           (cons 0 "LWPOLYLINE") <br />           (cons 100 "AcDbEntity") <br />           (cons 67 0) <br />           (cons 410 "Model") <br />           (cons 8 tcname) <br />           (cons 100 "AcDbPolyline") <br />           (cons 90 4) <br />           (cons 62 tccolor) <br />           (cons 70 1) <br />           (cons 43 0.0) <br />           (cons 38 0.0) <br />           (cons 39 0.0) <br />           (cons 10 pt1) <br />           (cons 40 0.0) <br />           (cons 41 0.0) <br />           (cons 42 0.0) <br />           (cons 10 pt2) <br />           (cons 40 0.0) <br />           (cons 41 0.0) <br />           (cons 42 0.0) <br />           (cons 10 pt3) <br />           (cons 40 0.0) <br />           (cons 41 0.0) <br />           (cons 42 0.0) <br />           (cons 10 pt4) <br />           (cons 40 0.0) <br />           (cons 41 0.0) <br />           (cons 42 0.0) <br />           (list 210 0.0 0.0 1.0)<br />       )<br />     )<br /> )<br />

需要下载代码的,可以直接下载附件

dingtiedt

顶一下，对学习标注文字避让应该很有用，谢谢分享！

mmmmmm

建议直接从CGM_REC_图层的矩形中创建一个有碰撞的矩形列表clash，在判断前首先判断矩形是否属于clash，如果属于直接跳过，否则才执行选择判断，如果只有一个实体，可直接删除该矩形，否则将选中的实体全部加入clash，这样应该可以减少逐一运算的个数，提高速度。
如此处理完成后，图内剩下的CGM_REC_图层矩形即为有碰撞的位置。

xiaomm250

mmmmmm 发表于 2015-9-21 19:32
建议直接从CGM_REC_图层的矩形中创建一个有碰撞的矩形列表clash，在判断前首先判断矩形是否属于clash，如果 ...

不是太明白啥意思?