[LISP程序]：一个用xdrx_api写的"文字插入"的程序

xgwl

由于刚学编程，程序可能啰唆了点！对xdrx_api更是糊涂，所以只好拿晓东以前写过的程序改了些地方，加了些地方！就这样，也让我想了半天，改了很多遍！请高手们批评指正！

另：本程序考虑了文字旋转的问题，无论文字处于何种角度！

    本程序只对普通文字有效，不知怎样才能支持mtext! (呵呵，水平有限)

    问：程序中"$xdlsp_txtbrk" 在xdrx_api说明中没查到是函数，是不是本身就是调用"$xdlsp_txtbrk"
子函数呢？

2. 
   
3.   [FONT=courier new]
   
4. (defun c:txt_add (/ bb ent1 el1 ee be en_data apt_int_date apt_int
   
5.                  apt_intx apt_inty apt_ang_dat ang txt p1 ptx pty)
   
6. (princ "\n ******* 文字插入程序 ******* 扬州xg")  
   
7.          (setvar "CMDECHO" 0)
   
8.   (if int_pt
   
9.      (progn
   
10.       (princ "\n [~~]拾取图中文字/请输入要插入的文字<")
    
11.       (setq int_pt1 (princ int_pt))
    
12.       (setq int_pt (getstring ">:"))
    
13.      )
    
14.      (progn     
    
15.        (setq int_pt1 "、")
    
16.        (setq int_pt (getstring "\n [~~]拾取图中文字/请输入要插入的文字<、>:"))
    
17.      )
    
18.   )
    
19.     (if (= int_pt "")
    
20.        (setq  int_pt int_pt1)
    
21.     )
    
22.     (if (= int_pt "~~")
    
23.           (progn
    
24.            (setq bb (nentsel "\n拾取图中文字:"))
    
25.            (setq ent1 (car bb))
    
26.            (setq el1 (entget ent1))   
    
27.            (setq int_pt (cdr (assoc 1 el1)))
    
28.            (princ "\n ")
    
29.            (princ "\n拾取文字内容为:") (princ int_pt)
    
30.           )
    
31.     )
    
32.            (setq ee (xdrx_entsel "\n请点取要处理的文字<退出>:"))
    
33. (if (/= ee nil)
    
34.    (progn   
    
35.            (setq be (car ee))
    
36.            (setq en_data (entget  be))
    
37.            (setq apt_int_date (assoc 10 en_data))
    
38.            (setq apt_int (cdr apt_int_date))
    
39.            (setq apt_intx (car apt_int))
    
40.            (setq apt_inty (cadr apt_int))
    
41.            (setq apt_ang_date (assoc 50 en_data))
    
42.            (setq ang (cdr apt_ang_date))               
    
43.      (while  
    
44.        (progn                                                    
    
45.         (setq txt (xdrx_getentdxf 1))
    
46.         (setq p1 (getpoint "\n请点取文字插入位置<退出>:"))
    
47.         (setq ptx (car p1))
    
48.         (setq pty (cadr p1))
    
49.         (if (/= p1 nil)                           
    
50.           (progn
    
51.             (xdrx_begin)
    
52.             (if (not (setq pos1 (car ($xdlsp_txtbrk be p1))))  
    
53.                 (progn
    
54.                     (cond  ((and (< (-  ptx apt_intx) 0) (>= ang 0) (< ang (* pi 0.5)))                  
    
55.                                  (setq pos1 0)
    
56.                            )
    
57.                            ((and (> (-  ptx apt_intx) 0) (>= ang 0) (< ang (* pi 0.5)))                  
    
58.                                  (setq pos1 (strlen txt))
    
59.                            )
    
60.                            ((and (> (-  ptx apt_intx) 0)  (> ang (* pi 0.5)) (< ang  (* pi 1.5)))                  
    
61.                                  (setq pos1 0)
    
62.                            )
    
63.                            ((and (< (-  ptx apt_intx) 0)  (> ang (* pi 0.5)) (< ang  (* pi 1.5)))                  
    
64.                                  (setq pos1 (strlen txt))
    
65.                            )
    
66.                            ((and (< (-  ptx apt_intx) 0)  (> ang (* pi 1.5)) (<= ang  (* pi 2)))                  
    
67.                                  (setq pos1 0)
    
68.                            )
    
69.                            ((and (> (-  ptx apt_intx) 0)  (> ang (* pi 1.5)) (<= ang  (* pi 2)))                  
    
70.                                  (setq pos1 (strlen txt))
    
71.                            )
    
72.                            ((and (< (-  pty apt_inty) 0)  (= ang (* pi 0.5)))                  
    
73.                                  (setq pos1 0)
    
74.                            )
    
75.                            ((and (> (-  pty apt_inty) 0)  (= ang (* pi 0.5)))                  
    
76.                                  (setq pos1 (strlen txt))
    
77.                            )  
    
78.                            ((and (> (-  pty apt_inty) 0)  (= ang (* pi 1.5)))                  
    
79.                                  (setq pos1 0)
    
80.                            )
    
81.                            ((and (< (-  pty apt_inty) 0)  (= ang (* pi 1.5)))                  
    
82.                                  (setq pos1 (strlen txt))
    
83.                            )                        
    
84.                     ) ; end cond            
    
85.                        ) ; end progn                                    
    
86.             ) ; end if            
    
87.                            (setq txt (xdrx_string_Insert txt pos1 int_pt))
    
88.                            (xdrx_setenttodb be)
    
89.                            (xdrx_modent 1 txt)           
    
90.                            (xdrx_end)            
    
91.           )                                                                                ; end progn          
    
92.          )                                                                                 ; end if
    
93.         )                                                                                  ; end progn   
    
94.     )                                                                                      ; end while
    
95.   )                                                                                        ; end progn
    
96. )                                                                                         ; end if
    
97.   (princ)
    
98. )
    
99.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun c:txt_add (/ bb ent1 el1 ee be en_data apt_int_date apt_int <br />                  apt_intx apt_inty apt_ang_dat ang txt p1 ptx pty)<br /> (princ "\n ******* 文字插入程序 ******* 扬州xg")  <br />          (setvar "CMDECHO" 0)<br />   (if int_pt<br />      (progn<br />       (princ "\n [~~]拾取图中文字/请输入要插入的文字<")<br />       (setq int_pt1 (princ int_pt))<br />       (setq int_pt (getstring ">:"))<br />      )<br />      (progn     <br />        (setq int_pt1 "、")<br />        (setq int_pt (getstring "\n [~~]拾取图中文字/请输入要插入的文字<、>:")) <br />      )<br />   )<br />     (if (= int_pt "")<br />        (setq  int_pt int_pt1)<br />     )<br />     (if (= int_pt "~~")<br />           (progn<br />            (setq bb (nentsel "\n拾取图中文字:"))<br />            (setq ent1 (car bb))<br />            (setq el1 (entget ent1))    <br />            (setq int_pt (cdr (assoc 1 el1)))<br />            (princ "\n ")<br />            (princ "\n拾取文字内容为:") (princ int_pt) <br />           )<br />     )<br />            (setq ee (xdrx_entsel "\n请点取要处理的文字<退出>:"))<br /> (if (/= ee nil)<br />    (progn   <br />            (setq be (car ee))<br />            (setq en_data (entget  be))<br />            (setq apt_int_date (assoc 10 en_data))<br />            (setq apt_int (cdr apt_int_date))<br />            (setq apt_intx (car apt_int))<br />            (setq apt_inty (cadr apt_int)) <br />            (setq apt_ang_date (assoc 50 en_data))<br />            (setq ang (cdr apt_ang_date))               <br />      (while  <br />        (progn                                                     <br />         (setq txt (xdrx_getentdxf 1))<br />         (setq p1 (getpoint "\n请点取文字插入位置<退出>:"))<br />         (setq ptx (car p1))<br />         (setq pty (cadr p1))<br />         (if (/= p1 nil)                           <br />           (progn<br />             (xdrx_begin)<br />             (if (not (setq pos1 (car ($xdlsp_txtbrk be p1))))  <br />                 (progn<br />                     (cond  ((and (< (-  ptx apt_intx) 0) (>= ang 0) (< ang (* pi 0.5)))                  <br />                                  (setq pos1 0)<br />                            )<br />                            ((and (> (-  ptx apt_intx) 0) (>= ang 0) (< ang (* pi 0.5)))                  <br />                                  (setq pos1 (strlen txt))<br />                            )<br />                            ((and (> (-  ptx apt_intx) 0)  (> ang (* pi 0.5)) (< ang  (* pi 1.5)))                  <br />                                  (setq pos1 0)<br />                            ) <br />                            ((and (< (-  ptx apt_intx) 0)  (> ang (* pi 0.5)) (< ang  (* pi 1.5)))                  <br />                                  (setq pos1 (strlen txt))<br />                            ) <br />                            ((and (< (-  ptx apt_intx) 0)  (> ang (* pi 1.5)) (<= ang  (* pi 2)))                  <br />                                  (setq pos1 0)<br />                            )<br />                            ((and (> (-  ptx apt_intx) 0)  (> ang (* pi 1.5)) (<= ang  (* pi 2)))                  <br />                                  (setq pos1 (strlen txt))<br />                            )<br />                            ((and (< (-  pty apt_inty) 0)  (= ang (* pi 0.5)))                  <br />                                  (setq pos1 0)<br />                            ) <br />                            ((and (> (-  pty apt_inty) 0)  (= ang (* pi 0.5)))                  <br />                                  (setq pos1 (strlen txt))<br />                            )  <br />                            ((and (> (-  pty apt_inty) 0)  (= ang (* pi 1.5)))                  <br />                                  (setq pos1 0)<br />                            ) <br />                            ((and (< (-  pty apt_inty) 0)  (= ang (* pi 1.5)))                  <br />                                  (setq pos1 (strlen txt))<br />                            )                         <br />                     ) ; end cond             <br />                        ) ; end progn                                     <br />             ) ; end if            <br />                            (setq txt (xdrx_string_Insert txt pos1 int_pt))<br />                            (xdrx_setenttodb be)<br />                            (xdrx_modent 1 txt)           <br />                            (xdrx_end)            <br />           )                                                                                ; end progn          <br />          )                                                                                 ; end if<br />         )                                                                                  ; end progn    <br />     )                                                                                      ; end while<br />   )                                                                                        ; end progn<br /> )                                                                                         ; end if<br />   (princ)<br /> )<br />   [/FONT]<br />

eachy

$xdlsp_ 开头的函数在 Lisp 目录下 xdlsp.lsp 文件中定义。

blue_mouth

这个命令好像会出错

hhy1985

郁闷死了~~~~我邮箱h_h_y8@126.com斑竹给我发一个吧

lyj1998

高手，，今天第一次看到有这人附件，，这省去了我的很多麻烦。再次感谢斑竹！

lyl6414300

错误 : no function definition: XDRX_ENTSEL

xgwl

要先加载xdapi 或者你先装XD工具箱！

riyuecao

有点用处 不错 谢谢楼主了 楼主辛苦了

puzhixing123

pzxok@126.com

hzz0758

不错，不过在写字板写好‘再copy进来就好多了’谢谢你的辛勤劳动

kikigz88

能不能脱离晓东啊
晓东用不了啊2004de