[分享]：使用函数生成文本的好处（附函数）

fylinwater

使用函数生成文本的好处（附函数）
1.速度快
2.不容易出错，使用COMMAND函数时如果当前字体高度是个固定值，就会出错
3.容易控制文本属性，你可以随意控制文本的属性，而且使用还比COMMAND函数简洁,可以忽略次要属性。
4.可以有返回值，后附的函数返回生成的文本的ENTNAME

2. 
   
3. ;;-------------------------------------------------
   
4. ;;#$help.begin
   
5. ;;##function.name->  (dd_creatext txt   p lst)
   
6. ;;##keyword-> create text   生成 文本
   
7. ;;##Description->   生成 文本  比command text 安全方便  
   
8. ;;##Arguments.begin
   
9. ;|  
   
10.    txt  <string> 文本字符
    
11.    p  <point>文本插入点
    
12.    lst=( h LAYER w ts) 文本次要属性表,可以只要部分属性或者为 nil
    
13.    h  <real> 文本高度
    
14.    layer <string> 层名
    
15.    w  <real>  文本度
    
16.    ts <string> 文本字型|;
    
17. ;;##Arguments.end
    
18. ;;##return->  entlist
    
19. ;;##examples.begin
    
20. ;|   (dd_creatext "DDTEST" '(0 0 0) '( 1.0 ) )     |;
    
21. ;;##examples.end
    
22. ;;##see also->
    
23. ;;#$help.end
    
24. ;;-------------------------------------------------
    
25. 
    
26. ;;##use function->
    
27. ;;##use ddsysvar->
    
28. ;;##Variable Description ;|  |;
    
29. (defun dd_creatext (TXT P  lst / otxtlst txtlst  h LAYER w ts)
    
30.   
    
31.   (SETQ H (CAR LST)  LST (CDR LST))
    
32.   (SETQ LAYER (CAR LST)  LST (CDR LST))
    
33.   (SETQ W (CAR LST)  LST (CDR LST))
    
34.   (SETQ TS (CAR LST)  LST (CDR LST))
    
35. 
    
36.     (IF (NULL H )  (SETQ H (getvar "TEXTSIZE")))
    
37.     (IF (NULL LAYER) (setq layer (getvar "clayer")))
    
38.     (IF (NULL TS) (SETQ TS (getvar "TEXTSTYLE")))
    
39.     (IF (NULL w) (SETQ w  (cdr (assoc 41 (entget (tblobjname "style" ts))))))
    
40.      ;;;;;;;;;;;;
    
41.      (setq otxtlst ( list  '(0 . "TEXT")  '(100 . "AcDbEntity") '(67 . 0)  '(100 . "AcDbText") '(50 . 0.0)  '(51 . 0.0)
    
42. '(71 . 0) '(72 . 0) '(11 0.0 0.0 0.0)  '(210 0.0 0.0 1.0) '(100 . "AcDbText") '(73 . 0)))
    
43.                           
    
44.     ;;;;;;;;;;;;;
    
45.     (setq txtlst (append oTXTlst (list (cons 10 P) (cons 8 layer)  (cons 40 h) (cons 1 txt) (CONS 7  TS) (cons 41 w) )))
    
46.   ;;(if dd*testmode* (print entlst))
    
47.    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    
48.      (if (entmake txtlst) (entlast))  ;;;返回实体名
    
49.   
    
50. )
    

<br /> ;;-------------------------------------------------<br /> ;;#$help.begin<br /> ;;##function.name->  (dd_creatext txt   p lst)<br /> ;;##keyword-> create text   生成 文本 <br /> ;;##Description->   生成 文本  比command text 安全方便  <br /> ;;##Arguments.begin<br /> ;|  <br />    txt  <string> 文本字符<br />    p  <point>文本插入点<br />    lst=( h LAYER w ts) 文本次要属性表,可以只要部分属性或者为 nil<br />    h  <real> 文本高度<br />    layer <string> 层名<br />    w  <real>  文本度<br />    ts <string> 文本字型|;<br /> ;;##Arguments.end<br /> ;;##return->  entlist <br /> ;;##examples.begin<br /> ;|   (dd_creatext "DDTEST" '(0 0 0) '( 1.0 ) )     |;<br /> ;;##examples.end<br /> ;;##see also-><br /> ;;#$help.end<br /> ;;-------------------------------------------------<br /> <br /> ;;##use function-><br /> ;;##use ddsysvar-><br /> ;;##Variable Description ;|  |;<br /> (defun dd_creatext (TXT P  lst / otxtlst txtlst  h LAYER w ts)<br />   <br />   (SETQ H (CAR LST)  LST (CDR LST))<br />   (SETQ LAYER (CAR LST)  LST (CDR LST))<br />   (SETQ W (CAR LST)  LST (CDR LST))<br />   (SETQ TS (CAR LST)  LST (CDR LST))<br /> <br />     (IF (NULL H )  (SETQ H (getvar "TEXTSIZE")))<br />     (IF (NULL LAYER) (setq layer (getvar "clayer")))<br />     (IF (NULL TS) (SETQ TS (getvar "TEXTSTYLE")))<br />     (IF (NULL w) (SETQ w  (cdr (assoc 41 (entget (tblobjname "style" ts))))))<br />      ;;;;;;;;;;;;<br />      (setq otxtlst ( list  '(0 . "TEXT")  '(100 . "AcDbEntity") '(67 . 0)  '(100 . "AcDbText") '(50 . 0.0)  '(51 . 0.0) <br /> '(71 . 0) '(72 . 0) '(11 0.0 0.0 0.0)  '(210 0.0 0.0 1.0) '(100 . "AcDbText") '(73 . 0)))<br />                            <br />     ;;;;;;;;;;;;;<br />     (setq txtlst (append oTXTlst (list (cons 10 P) (cons 8 layer)  (cons 40 h) (cons 1 txt) (CONS 7  TS) (cons 41 w) )))<br />   ;;(if dd*testmode* (print entlst))<br />    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br />      (if (entmake txtlst) (entlast))  ;;;返回实体名<br />   <br /> )<br />

cy956

我也觉得stdlib的很乱，主要是没法一个一个细看。我用的是当时从
圆方还是中望的lisp中咪来自己补充的，格式和原程序的差不多。

2. 
   
3. 
   
4. ;;制造 TEXT 实体  (#m_txt1 pt txt "dxfs" (* 3 0bl) 0.7 0 "L" lay color)
   
5. 
   
6. (defun #m_txt1 (pt txt sty th wid tan dq lay color / DQ1 D72 D73)
   
7.   (setq dq1(strcase dq))
   
8.   (cond
   
9.     ((OR(= dq1 "L")(= dq1 "")) (setq d72 0 d73 0))
   
10.     ((= dq1 "C")(setq d72 1 d73 0))
    
11.     ((= dq1 "R")(setq d72 2 d73 0))
    
12.     ((= dq1 "A")(setq d72 3 d73 0))
    
13.     ((= dq1 "M")(setq d72 4 d73 3))
    
14.     ((= dq1 "F")(setq d72 5 d73 0))
    
15. 
    
16.     ((= dq1 "TL")(setq d72 0 d73 3))
    
17.     ((= dq1 "TC")(setq d72 1 d73 3))
    
18.     ((= dq1 "TR")(setq d72 2 d73 3))
    
19. 
    
20.     ((= dq1 "ML")(setq d72 0 d73 2))
    
21.     ((= dq1 "MC")(setq d72 1 d73 2))
    
22.     ((= dq1 "MR")(setq d72 2 d73 2))
    
23. 
    
24.     ((= dq1 "BL")(setq d72 0 d73 1))
    
25.     ((= dq1 "BC")(setq d72 1 d73 1))
    
26.     ((= dq1 "BR")(setq d72 2 d73 1))
    
27.     (T  (setq d72 0 d73 0))
    
28.   )
    
29. (if (and (= d72 0)(= d73 0))
    
30.   (setq en000 (list
    
31.       (cons 0 "TEXT")
    
32.       (cons 1 txt)
    
33.       (cons 7 sty)
    
34.       (cons 8 lay)
    
35.       (cons 10 pt)
    
36.       (cons 40 th)
    
37.       (cons 41 wid)
    
38.       (cons 50 tan)
    
39.       (cons 72 d72)
    
40.       (cons 73 d73)   ) )
    
41.   (setq en000 (list
    
42.       (cons 0 "TEXT")
    
43.       (cons 1 txt)
    
44.       (cons 7 sty)
    
45.       (cons 8 lay)
    
46.       (cons 10 pt)
    
47.       (cons 11 pt)
    
48.       (cons 40 th)
    
49.       (cons 41 wid)
    
50.       (cons 50 tan)
    
51.       (cons 72 d72)
    
52.       (cons 73 d73)   ) )
    
53.   )
    
54.   (IF (= STY "STANDARD")(setq en000 (append en000 (list (cons 51 0.261799)))))
    
55.   (if (/= -1 color) (setq en000 (append en000 (list (cons 62 color)))))
    
56.   (if (= nil (entmake en000)) (princ "\n制造 TEXT 实体失败.")  )
    
57. )
    
58. 
    
59. 
    

<br /> <br /> ;;制造 TEXT 实体  (#m_txt1 pt txt "dxfs" (* 3 0bl) 0.7 0 "L" lay color)<br /> <br /> (defun #m_txt1 (pt txt sty th wid tan dq lay color / DQ1 D72 D73)<br />   (setq dq1(strcase dq))<br />   (cond<br />     ((OR(= dq1 "L")(= dq1 "")) (setq d72 0 d73 0))<br />     ((= dq1 "C")(setq d72 1 d73 0))<br />     ((= dq1 "R")(setq d72 2 d73 0))<br />     ((= dq1 "A")(setq d72 3 d73 0))<br />     ((= dq1 "M")(setq d72 4 d73 3))<br />     ((= dq1 "F")(setq d72 5 d73 0))<br /> <br />     ((= dq1 "TL")(setq d72 0 d73 3))<br />     ((= dq1 "TC")(setq d72 1 d73 3))<br />     ((= dq1 "TR")(setq d72 2 d73 3))<br /> <br />     ((= dq1 "ML")(setq d72 0 d73 2))<br />     ((= dq1 "MC")(setq d72 1 d73 2))<br />     ((= dq1 "MR")(setq d72 2 d73 2))<br /> <br />     ((= dq1 "BL")(setq d72 0 d73 1))<br />     ((= dq1 "BC")(setq d72 1 d73 1))<br />     ((= dq1 "BR")(setq d72 2 d73 1))<br />     (T  (setq d72 0 d73 0))<br />   )<br /> (if (and (= d72 0)(= d73 0))<br />   (setq en000 (list<br />       (cons 0 "TEXT")<br />       (cons 1 txt)<br />       (cons 7 sty)<br />       (cons 8 lay)<br />       (cons 10 pt)<br />       (cons 40 th)<br />       (cons 41 wid)<br />       (cons 50 tan)<br />       (cons 72 d72) <br />       (cons 73 d73)   ) )<br />   (setq en000 (list<br />       (cons 0 "TEXT")<br />       (cons 1 txt)<br />       (cons 7 sty)<br />       (cons 8 lay)<br />       (cons 10 pt)<br />       (cons 11 pt)<br />       (cons 40 th)<br />       (cons 41 wid)<br />       (cons 50 tan)<br />       (cons 72 d72) <br />       (cons 73 d73)   ) )<br />   )<br />   (IF (= STY "STANDARD")(setq en000 (append en000 (list (cons 51 0.261799)))))<br />   (if (/= -1 color) (setq en000 (append en000 (list (cons 62 color)))))<br />   (if (= nil (entmake en000)) (princ "\n制造 TEXT 实体失败.")  )<br /> )<br /> <br /> <br />

fylinwater

对啊 STDLIB实在太罗索了，开始我就按照它的思想作的，结果由于参数的不同，一个函数产生很多不同版本，只好用后缀1 2 3表示，
使用很不方便，而且容易出错，但LISP又不可以定义缺省参数的函数，
直到最近才想到将次要参数封装在一个表里，这样等于可以使用缺省参数的函数了