求板厚标注，字体大小点选原图中的板厚标注的lLSP 0004

品茗新秀

求板厚标注，字体大小点选原图中的板厚标注lLSP   0004

关于是用如H=100  或d=100 还是圈中带100，这个由用户确定或点选原图的样式

yjr111

简单的先来试试....
(连续点，带记忆）

yjr111

2楼更新...

品茗新秀

yjr111 发表于 2012-9-8 23:56
2楼更新...

最好能连续点，不要点一次，就让用户输一次板厚

yjr111

行了，睡觉了，那个拉伸的估计比较头疼...主要是看得有点眼花

flytoday

顶上哈一一

yjr111

flytoday 发表于 2012-9-9 00:52
顶上哈一一

yjr111

附上源码：

2. (defun c:bhbz()
   
3.   (command "ucs" "")
   
4.   (setq E(nentsel"\n点选原板厚标注文字以提取字高等"))
   
5.   (if (=(cdr(assoc 0 (SETQ TS(entget(car E)))))"TEXT")
   
6.     (progn
   
7.     (SETQ TSTY(CDR(ASSOC 7 TS))
   
8.           la(CDR(ASSOC 8 TS))
   
9.           TH(CDR(ASSOC 40 TS))
   
10.           tw(CDR(ASSOC 41 TS))
    
11.           tcol(CDR(ASSOC 62 TS))
    
12.           )
    
13.     (if (not tcol)
    
14.       (setq tcol (cdr(assoc 62(entget(tblobjname "layer" la)))))
    
15.       )
    
16.     )
    
17.     (progn
    
18.     (princ"\n未选中文字...")
    
19.     (c:bhbz)
    
20.     )
    
21.    )
    
22.    (if *BH* (setq BH (getint (strcat "\n请输入板厚<" (rtos *BH* 2 0)">")))
    
23.                   (setq BH (getint  "\n请输入板厚" ))
    
24.    )
    
25.   (if (not BH)(setq BH *BH*)(setq *BH* BH ))
    
26.   (initget"H D Q W")
    
27.   (SETQ KEY(GETKWORD"\n输入标注样式:[前缀1(H)/前缀2(D)/带圈前缀1(Q)/带圈前缀2(W)]"))
    
28.   (while (SETQ pt(GETpoint"\n请确定文字放置点"))
    
29.     (cond
    
30.       ((= key "H")
    
31.        (SETQ STR (strcat "H="(itoa BH)))
    
32.        (EMAKET STR TSTY la PT TH tcol)
    
33.        )
    
34.       ((= key "D")
    
35.        (SETQ STR (strcat "d="(itoa BH)))
    
36.        (EMAKET STR TSTY la PT TH tcol)
    
37.        )
    
38.       ((= key "Q")
    
39.        (SETQ STR (strcat "H="(itoa BH)))
    
40.        (EMAKET STR TSTY la PT TH tcol)
    
41.        (setq p10 (cdr(assoc 10 (entget(entlast))))
    
42.              p11(cdr(assoc 11 (entget(entlast))))
    
43.              )
    
44.        (EMAKEEL p11 p10 la tcol BH)
    
45.        )
    
46.       ((= key "W")
    
47.       (SETQ STR (strcat "d="(itoa BH)))
    
48.        (EMAKET STR TSTY la PT TH tcol)
    
49.        (setq p10 (cdr(assoc 10 (entget(entlast))))
    
50.              p11(cdr(assoc 11 (entget(entlast))))
    
51.              )
    
52.        (EMAKEEL p11 p10 la tcol BH)
    
53.        )
    
54.       )
    
55.     )
    
56.   (princ)
    
57.   )
    
58. (DEFUN EMAKET(STR TSTY la PT TH tcol)
    
59.   (entmake (list '(0 . "TEXT") (cons 1 STR) (cons 7 TSTY)
    
60.                       (cons 8 la)(cons 10 '(0.0 0.0 0.0))(cons 11 PT)
    
61.                       (cons 40 TH)(cons 41 Tw)(cons 62 tcol)
    
62.                       (cons 72 1)(cons 73 2))
    
63.                 )
    
64.   )
    
65. (DEFUN EMAKEEL(p11 p10 la tcol BH)
    
66.   (entmake (list '(0 . "ELLIPSE")  '(100 . "AcDbEntity")'(100 . "AcDbEllipse")(cons 10 p11)
    
67.                       (cons 11 (list (* 1.4(- (car p10)(car p11)))0.0 0.0))(cons 8 la)(cons 62 tcol)
    
68.                       (cons 40 (/ 1 (* 0.55 (strlen (itoa BH)))))'(42 . 6.28319)
    
69.       
    
70.                      )
    
71.                 )
    
72.   )
    
73.   
    
74.           
    
75.           
    
76.                
    
77.        

(defun c:bhbz()<br />   (command "ucs" "")<br />   (setq E(nentsel"\n点选原板厚标注文字以提取字高等"))<br />   (if (=(cdr(assoc 0 (SETQ TS(entget(car E)))))"TEXT")<br />     (progn<br />     (SETQ TSTY(CDR(ASSOC 7 TS))<br />           la(CDR(ASSOC 8 TS))<br />           TH(CDR(ASSOC 40 TS))<br />           tw(CDR(ASSOC 41 TS))<br />           tcol(CDR(ASSOC 62 TS))<br />           )<br />     (if (not tcol)<br />       (setq tcol (cdr(assoc 62(entget(tblobjname "layer" la)))))<br />       )<br />     )<br />     (progn<br />     (princ"\n未选中文字...")<br />     (c:bhbz)<br />     )<br />    )<br />    (if *BH* (setq BH (getint (strcat "\n请输入板厚<" (rtos *BH* 2 0)">")))<br />                   (setq BH (getint  "\n请输入板厚" ))<br />    )<br />   (if (not BH)(setq BH *BH*)(setq *BH* BH ))<br />   (initget"H D Q W")<br />   (SETQ KEY(GETKWORD"\n输入标注样式:[前缀1(H)/前缀2(D)/带圈前缀1(Q)/带圈前缀2(W)]"))<br />   (while (SETQ pt(GETpoint"\n请确定文字放置点"))<br />     (cond<br />       ((= key "H")<br />        (SETQ STR (strcat "H="(itoa BH)))<br />        (EMAKET STR TSTY la PT TH tcol)<br />        )<br />       ((= key "D")<br />        (SETQ STR (strcat "d="(itoa BH)))<br />        (EMAKET STR TSTY la PT TH tcol)<br />        )<br />       ((= key "Q")<br />        (SETQ STR (strcat "H="(itoa BH)))<br />        (EMAKET STR TSTY la PT TH tcol)<br />        (setq p10 (cdr(assoc 10 (entget(entlast))))<br />              p11(cdr(assoc 11 (entget(entlast))))<br />              )<br />        (EMAKEEL p11 p10 la tcol BH)<br />        )<br />       ((= key "W")<br />       (SETQ STR (strcat "d="(itoa BH)))<br />        (EMAKET STR TSTY la PT TH tcol)<br />        (setq p10 (cdr(assoc 10 (entget(entlast))))<br />              p11(cdr(assoc 11 (entget(entlast))))<br />              )<br />        (EMAKEEL p11 p10 la tcol BH)<br />        )<br />       )<br />     )<br />   (princ)<br />   )<br /> (DEFUN EMAKET(STR TSTY la PT TH tcol)<br />   (entmake (list '(0 . "TEXT") (cons 1 STR) (cons 7 TSTY)<br />                       (cons 8 la)(cons 10 '(0.0 0.0 0.0))(cons 11 PT)<br />                       (cons 40 TH)(cons 41 Tw)(cons 62 tcol)<br />                       (cons 72 1)(cons 73 2))<br />                 )<br />   )<br /> (DEFUN EMAKEEL(p11 p10 la tcol BH)<br />   (entmake (list '(0 . "ELLIPSE")  '(100 . "AcDbEntity")'(100 . "AcDbEllipse")(cons 10 p11)<br />                       (cons 11 (list (* 1.4(- (car p10)(car p11)))0.0 0.0))(cons 8 la)(cons 62 tcol)<br />                       (cons 40 (/ 1 (* 0.55 (strlen (itoa BH)))))'(42 . 6.28319)<br />        <br />                      )<br />                 )<br />   ) <br />   <br />           <br />           <br />                 <br />        

love_cq

强大的资料，多谢大神分享，学习了。

奥特蛋

yjr111 发表于 2013-5-25 23:13
附上源码：

大神好多币