[求助]：在2004中，如何用lisp加载自己做的线型？

闲云

在2004中，如何用lisp加载自己做的线型？

eachy

最初由 闲云 发布
[B]在2004中，如何用lisp加载自己做的线型？ [/B]

用线型的替换字体样式

2. 
   
3. (defun $XDLSP_CHECKFONT ()
   
4.   (xdrx_sysvar_push "textstyle")
   
5.   (if (not (tblsearch "style" "xdtb_efont"))
   
6.     (command ".style" "xdtb_efont" "romans.shx" "0" "0.75" "0" "" "" "")
   
7.   )
   
8.   (if (not (tblsearch "style" "xdtb_cfont"))
   
9.     (command ".style" "xdtb_cfont" "romans,hztxt" "0" "0.75" "0" "" "" "")
   
10.   )
    
11.   (xdrx_sysvar_pop)
    
12.   (princ)
    
13. )
    
14. ;;; 错误处理

<br /> (defun $XDLSP_CHECKFONT ()<br />   (xdrx_sysvar_push "textstyle")<br />   (if (not (tblsearch "style" "xdtb_efont"))<br />     (command ".style" "xdtb_efont" "romans.shx" "0" "0.75" "0" "" "" "")<br />   )<br />   (if (not (tblsearch "style" "xdtb_cfont"))<br />     (command ".style" "xdtb_cfont" "romans,hztxt" "0" "0.75" "0" "" "" "")<br />   )<br />   (xdrx_sysvar_pop)<br />   (princ)<br /> )<br /> ;;; 错误处理

lijiao

最初由 闲云 发布
[B]在2004中，如何用lisp加载自己做的线型？ [/B]

这是我做的一段程序，用于对图纸设置进行标准化，供你参考。

2. 
   
3.   [FONT=courier new]
   
4. (defun c:set_update (/               file_name
   
5.                                           layersobj    ltypesobj
   
6.                                           cs_layer     cs_color
   
7.                                           cs_ltype     stylesobj
   
8.                                           cs_textname  styleobj
   
9.                                           blkobj
   
10.                                          )
    
11.   (setq file_name (open (findfile "shezhi.txt") "r"))
    
12.   (setq        layersobj (vla-get-layers
    
13.                     (vla-get-ActiveDocument (vlax-get-acad-object))
    
14.                   )
    
15.   )
    
16.   (setq        ltypesobj (vla-get-Linetypes
    
17.                     (vla-get-ActiveDocument (vlax-get-acad-object))
    
18.                   )
    
19.   )
    
20.   (repeat (read (read-line file_name))
    
21.     (setq cs_layer (read-line file_name))
    
22.     (setq cs_color (read-line file_name))
    
23.     (setq cs_ltype (read-line file_name))
    
24. 
    
25.     (if        (not (tblsearch "layer" cs_layer))
    
26.       (vla-add layersobj cs_layer)
    
27.     )
    
28.     (setq layerobj (vla-item layersobj cs_layer))
    
29.     (if        (not (tblsearch "ltype" cs_ltype))
    
30.       (vla-load ltypesobj cs_ltype "cs2003.lin")
    
31.     )
    
32.     (setq ltypeobj (vla-item ltypesobj cs_ltype))
    
33.     (vla-put-color layerobj cs_color)
    
34.     (vla-put-linetype layerobj cs_ltype)
    
35.   )
    
36.   (setq        stylesobj (vla-get-textstyles
    
37.                     (vla-get-ActiveDocument (vlax-get-acad-object))
    
38.                   )
    
39.   )
    
40.   (repeat (read (read-line file_name))
    
41.     (setq cs_textname (read-line file_name))
    
42.     (if        (not (tblsearch "style" cs_textname))
    
43.       (vla-add stylesobj cs_textname)
    
44.     )
    
45.     (setq styleobj (vla-item stylesobj cs_textname))
    
46.     (vla-put-fontFile styleobj (read-line file_name))
    
47.     (vla-put-BigFontFile styleobj (read-line file_name))
    
48.     (vla-put-Width styleobj (read (read-line file_name)))
    
49.   )
    
50.   (repeat (read (read-line file_name))
    
51.     (setvar (read-line file_name) (read (read-line file_name)))
    
52.   )
    
53.   (close file_name)
    
54.   (vla-CopyFrom
    
55.     (vla-get-ActiveDimStyle
    
56.       (vla-get-ActiveDocument (vlax-get-acad-object))
    
57.     )
    
58.     (vla-get-ActiveDocument (vlax-get-acad-object))
    
59.   )
    
60. 
    
61.   (vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object))
    
62.              acActiveViewport
    
63.   )
    
64.   (princ)
    
65. )
    
66.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun c:set_update (/               file_name<br />                                           layersobj    ltypesobj<br />                                           cs_layer     cs_color<br />                                           cs_ltype     stylesobj<br />                                           cs_textname  styleobj<br />                                           blkobj<br />                                          )<br />   (setq file_name (open (findfile "shezhi.txt") "r"))<br />   (setq        layersobj (vla-get-layers<br />                     (vla-get-ActiveDocument (vlax-get-acad-object))<br />                   )<br />   )<br />   (setq        ltypesobj (vla-get-Linetypes<br />                     (vla-get-ActiveDocument (vlax-get-acad-object))<br />                   )<br />   )<br />   (repeat (read (read-line file_name))<br />     (setq cs_layer (read-line file_name))<br />     (setq cs_color (read-line file_name))<br />     (setq cs_ltype (read-line file_name))<br /> <br />     (if        (not (tblsearch "layer" cs_layer))<br />       (vla-add layersobj cs_layer)<br />     )<br />     (setq layerobj (vla-item layersobj cs_layer))<br />     (if        (not (tblsearch "ltype" cs_ltype))<br />       (vla-load ltypesobj cs_ltype "cs2003.lin")<br />     )<br />     (setq ltypeobj (vla-item ltypesobj cs_ltype))<br />     (vla-put-color layerobj cs_color)<br />     (vla-put-linetype layerobj cs_ltype)<br />   )<br />   (setq        stylesobj (vla-get-textstyles<br />                     (vla-get-ActiveDocument (vlax-get-acad-object))<br />                   )<br />   )<br />   (repeat (read (read-line file_name))<br />     (setq cs_textname (read-line file_name))<br />     (if        (not (tblsearch "style" cs_textname))<br />       (vla-add stylesobj cs_textname)<br />     )<br />     (setq styleobj (vla-item stylesobj cs_textname))<br />     (vla-put-fontFile styleobj (read-line file_name))<br />     (vla-put-BigFontFile styleobj (read-line file_name))<br />     (vla-put-Width styleobj (read (read-line file_name)))<br />   )<br />   (repeat (read (read-line file_name))<br />     (setvar (read-line file_name) (read (read-line file_name)))<br />   )<br />   (close file_name)<br />   (vla-CopyFrom<br />     (vla-get-ActiveDimStyle<br />       (vla-get-ActiveDocument (vlax-get-acad-object))<br />     )<br />     (vla-get-ActiveDocument (vlax-get-acad-object))<br />   )<br /> <br />   (vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object))<br />              acActiveViewport<br />   )<br />   (princ)<br /> )<br />   [/FONT]<br />

附件是两个支持文件，请放在搜索路径中。