CAD逐条添加文本

dpf200810

运用小程序需要安装Microsoft .NET Framework4.0

yangchao2005090

正好用的到，不过要是lsp就好了

guohq

1. (vl-load-com)
   
2. (defun C:T0603( / FilePath FFile FLine TextList  MS Index InsertPt)   
   
3.   (setq FilePath (getfiled "选择待标注的文件" "" "" 8))  
   
4.   (if (null FilePath)
   
5.     (exit)
   
6.     )
   
7.   (setq FFile (open FilePath "r") TextList '())
   
8.   (setq FLine (read-line FFile))
   
9.   (while FLine
   
10.     (setq TextList (cons FLine TextList))
    
11.     (setq FLine (read-line FFile))
    
12.     )
    
13.   (close FFile)
    
14.   (setq TextList (reverse TextList));反向
    
15.   (setq MS (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
    
16.   (setq Index 0)
    
17.   (repeat (length TextList)
    
18.     (setq FLine (nth Index TextList) Index (1+ Index))
    
19.     (setq InsertPt (getpoint "\n拾取插入点"))
    
20.     (if InsertPt
    
21.       (vla-addtext MS FLine (vlax-3d-point InsertPt) 2)
    
22.       )
    
23.     )
    
24.   (prin1)
    
25.   )

(vl-load-com)<br /> (defun C:T0603( / FilePath FFile FLine TextList  MS Index InsertPt)   <br />   (setq FilePath (getfiled "选择待标注的文件" "" "" 8))  <br />   (if (null FilePath)<br />     (exit)<br />     )<br />   (setq FFile (open FilePath "r") TextList '())<br />   (setq FLine (read-line FFile))<br />   (while FLine<br />     (setq TextList (cons FLine TextList))<br />     (setq FLine (read-line FFile))<br />     )<br />   (close FFile)<br />   (setq TextList (reverse TextList));反向<br />   (setq MS (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))<br />   (setq Index 0)<br />   (repeat (length TextList)<br />     (setq FLine (nth Index TextList) Index (1+ Index))<br />     (setq InsertPt (getpoint "\n拾取插入点"))<br />     (if InsertPt<br />       (vla-addtext MS FLine (vlax-3d-point InsertPt) 2)<br />       )<br />     )<br />   (prin1)<br />   )

好久没有写LISP了

cairunbin

guohq 发表于 2019-6-3 00:14
好久没有写LISP了

给你点个赞！超级快速反应啊。