如何用lisp新建一个图层

sachindkini

1. (defun c:MakeLayers nil (vl-load-com)  
   
2.   ;; © Lee Mac 2010
   
3. 
   
4.   ;;----------------------------------------------------------------------------------------------;;
   
5.   ;; Specifications:                                                                              ;;
   
6.   ;;----------------------------------------------------------------------------------------------;;
   
7.   ;; Description         Data Type       Remarks                                                  ;;
   
8.   ;;----------------------------------------------------------------------------------------------;;
   
9.   ;; Layer Name          STRING          Only standard chars allowed.                             ;;
   
10.   ;; Layer Colour        INTEGER         may be nil, -ve for Layer Off, Colour < 256              ;;
    
11.   ;; Layer Linetype      STRING          may be nil, If not loaded, CONTINUOUS.                   ;;
    
12.   ;; Layer Lineweight    REAL            may be nil, negative=Default, otherwise 0 <= x <= 2.11   ;;
    
13.   ;; Plot?               BOOLEAN         T = Plot Layer, nil otherwise                            ;;
    
14.   ;; Bit Flag            INTEGER         0=None, 1=Frozen, 2=Frozen in VP, 4=Locked               ;;
    
15.   ;; Description         STRING          may be nil for no description                            ;;
    
16.   ;;----------------------------------------------------------------------------------------------;;
    
17.   ;; Function will print list detailing any unsuccesful layers                                    ;;
    
18.   ;;----------------------------------------------------------------------------------------------;;
    
19.    
    
20.   (regapp "AcAecLayerStandard")
    
21. 
    
22.   (
    
23.     (lambda ( lst )
    
24.       (mapcar 'print
    
25.         (vl-remove-if 'cdr
    
26.           (mapcar
    
27.             (function
    
28.               (lambda ( x )
    
29.                 (if (caddr x) (LM:LoadLinetype (caddr x))) (cons (car x) (apply 'MakeLayer x))
    
30.               )
    
31.             )
    
32.             lst
    
33.           )
    
34.         )
    
35.       )
    
36.     )
    
37.    '(
    
38.     ;  Name                 Colour   Linetype    Lineweight Plot? Bitflag  Description
    
39.     ( "EL_COMPONENTS"            7  "CONTINUOUS"     -3       T      0     "componets")
    
40.     ( "EL_CONSTR_COMP"           1  "CONTINUOUS"     -3       T      0     "const"    )
    
41.     ( "EL_FITTINGS"              4  "CONTINUOUS"     -3       T      0     "fitting"  )
    
42.     ( "EL_LABEL"                 1  "CONTINUOUS"     -3       T      0      nil  )
    
43.     ( "EL_LABEL_TXT"           252  "CONTINUOUS"     -3       T      0      nil  )
    
44.     ( "EL_TERMINALS"             1  "CONTINUOUS"     -3       T      0      nil  )
    
45.     ( "EL_TERMINALS_PE"         24  "CONTINUOUS"     -3       T      0      nil  )
    
46.     ( "EL_TERMINALS_TXT"       252  "CONTINUOUS"     -3       T      0      nil  )
    
47.     ( "EL_TXT"                 252  "CONTINUOUS"     -3       T      0      nil  )
    
48.     ( "EL_WIRES"               252  "CONTINUOUS"     -3       T      0      nil  )
    
49.     ( "GE_ANNOTATION"            7  "CONTINUOUS"     -3       T      0      nil  )
    
50.     ( "GE_LABEL"                10  "CONTINUOUS"     -3       T      0      nil  )
    
51.     ( "GE_LABEL_TEXT"          253  "CONTINUOUS"     -3       T      0      nil  )
    
52.     ( "GE_TXT_LANGUAGE_DU"     252  "CONTINUOUS"     -3       T      0      nil  )
    
53.     ( "GE_TXT_LANGUAGE_EN"     252  "CONTINUOUS"     -3       T      0      nil  )
    
54.     ( "GE_TXT_LANGUAGE_FR"     252  "CONTINUOUS"     -3       T      0      nil  )
    
55.     ( "GE_TXT_LANGUAGE_GE"     252  "CONTINUOUS"     -3       T      0      nil  )
    
56.     ( "LA_HEADER_FRAME"          7  "CONTINUOUS"     -3       T      0      nil  )
    
57.     ( "LA_HEADER_TXT"            7  "CONTINUOUS"     -3       T      0      nil  )
    
58.     ( "LA_MATLIST"             254  "CONTINUOUS"     -3       T      0      nil  )
    
59.     ( "LA_MATLIST_FRAME"       254  "CONTINUOUS"     -3       T      0      nil  )
    
60.     ( "LA_MATLIST_POS"         254  "CONTINUOUS"     -3       T      0      nil  )
    
61.     ( "LA_MATLIST_TXT"         252  "CONTINUOUS"     -3       T      0      nil  )
    
62.     ( "LA_TITLE_FRAME"           7  "CONTINUOUS"     -3       T      0      nil  )
    
63.     ( "LA_TITLE_LOGO"           10  "CONTINUOUS"     -3       T      0      nil  )
    
64.     ( "LA_TITLE_LOGO_TXT"        7  "CONTINUOUS"     -3       T      0      nil  )
    
65.     ( "LA_TITLE_TXT"             7  "CONTINUOUS"     -3       T      0      nil  )
    
66.     ( "LA_VIEWPORTS"           230  "CONTINUOUS"     -3      nil     0      nil  )
    
67.     ( "PN_ACCESSORIES"          30  "CONTINUOUS"     -3       T      0      nil  )
    
68.     ( "PN_ACTUATORS"           160  "CONTINUOUS"     -3       T      0      nil  )
    
69.     ( "PN_AIR_LINE_EQUIPMENT"   40  "CONTINUOUS"     -3       T      0      nil  )
    
70.     ( "PN_BRACKET_MOUNTING"      1  "ACAD_ISO12W100" -3       T      0      nil  )
    
71.     ( "PN_CABINET"               8  "CONTINUOUS"     -3       T      0      nil  )
    
72.     ( "PN_CABINET_DIM"           8  "CONTINUOUS"     -3       T      0      nil  )
    
73.     ( "PN_COMPONENTS"            7  "CONTINUOUS"     -3       T      0      nil  )
    
74.     ( "PN_CONDUCTS"              3  "CONTINUOUS"     -3       T      0      nil  )
    
75.     ( "PN_CONSTR_COMP"           2  "CONTINUOUS"     -3       T      0      nil  )
    
76.     ( "PN_DRAIN"                 3  "HIDDEN"         -3       T      0      nil  )
    
77.     ( "PN_EXHAUST"             104  "CONTINUOUS"     -3       T      0      nil  )
    
78.     ( "PN_FITTINGS"             30  "CONTINUOUS"     -3       T      0      nil  )
    
79.     ( "PN_IDENTIFICATION"        4  "CONTINUOUS"     -3       T      0      nil  )
    
80.     ( "PN_PILOT_SUPPLY"          3  "HIDDEN"         -3       T      0      nil  )
    
81.     ( "PN_PORT_NUMBERS"          8  "CONTINUOUS"     -3       T      0      nil  )
    
82.     ( "PN_PRESSURE_SWITCHES"   200  "CONTINUOUS"     -3       T      0      nil  )
    
83.     ( "PN_PROPORTIONAL_VALVES" 226  "CONTINUOUS"     -3       T      0      nil  )
    
84.     ( "PN_SECTIONS"              3  "CONTINUOUS"     -3       T      0      nil  )
    
85.     ( "PN_SUB-BASES"             8  "ACAD_ISO12W100" -3       T      0      nil  )
    
86.     ( "PN_SUB-BASE_CONDUCTS"     2  "CONTINUOUS"     -3       T      0      nil  )
    
87.     ( "PN_SUPPLY"                3  "CONTINUOUS"     -3       T      0      nil  )
    
88.     ( "PN_TXT"                   3  "CONTINUOUS"     -3       T      0      nil  )
    
89.     ( "PN_VACUUM"               60  "CONTINUOUS"     -3       T      0      nil  )
    
90.     ( "PN_VALVES"              240  "CONTINUOUS"     -3       T      0      nil  )
    
91.     ( "PN_VALVES_OVERRIDE"       1  "CONTINUOUS"     -3       T      0      nil  )
    
92.     )
    
93.   )
    
94.   (princ)
    
95. )
    
96. 
    
97. (defun MakeLayer ( name colour linetype lineweight willplot bitflag description )
    
98.   ;; &#169; Lee Mac 2010
    
99.   (or (tblsearch "LAYER" name)
    
100.     (entmake
     
101.       (append
     
102.         (list
     
103.           (cons 0 "LAYER")
     
104.           (cons 100 "AcDbSymbolTableRecord")
     
105.           (cons 100 "AcDbLayerTableRecord")
     
106.           (cons 2  name)
     
107.           (cons 70 bitflag)
     
108.           (cons 290 (if willplot 1 0))
     
109.           (cons 6
     
110.             (if (and linetype (tblsearch "LTYPE" linetype))
     
111.               linetype "CONTINUOUS"
     
112.             )
     
113.           )
     
114.           (cons 62 (if (and colour (< 0 (abs colour) 256)) colour 7))
     
115.           (cons 370
     
116.             (if (minusp lineweight) -3
     
117.               (fix
     
118.                 (* 100
     
119.                   (if (and lineweight (<= 0.0 lineweight 2.11)) lineweight 0.0)
     
120.                 )
     
121.               )
     
122.             )
     
123.           )
     
124.         )
     
125.         (if description
     
126.           (list
     
127.             (list -3
     
128.               (list "AcAecLayerStandard" (cons 1000 "") (cons 1000 description))
     
129.             )
     
130.           )
     
131.         )
     
132.       )
     
133.     )
     
134.   )
     
135. )
     
136. 
     
137. ;;--------------------=={ Load Linetype }==-------------------;;
     
138. ;;                                                            ;;
     
139. ;;  Attempts to load a specified linetype from any linetype   ;;
     
140. ;;  definition files (.lin) found in the ACAD Support Path    ;;
     
141. ;;------------------------------------------------------------;;
     
142. ;;  Author: Lee Mac, Copyright &#169; 2011    ;;
     
143. ;;------------------------------------------------------------;;
     
144. ;;  Arguments:                                                ;;
     
145. ;;  lt - name of linetype to load                             ;;
     
146. ;;------------------------------------------------------------;;
     
147. ;;  Returns:  T if linetype loaded successfully, else nil     ;;
     
148. ;;------------------------------------------------------------;;
     
149. 
     
150. (defun LM:LoadLinetype ( lt )
     
151.   (cond
     
152.     ( (tblsearch "LTYPE" lt) )
     
153.     ( (progn
     
154.         (or acapp (setq acapp (vlax-get-acad-object)))
     
155.         (or acdoc (setq acdoc (vla-get-ActiveDocument acapp)))
     
156.         (or aclts (setq aclts (vla-get-Linetypes acdoc)))
     
157. 
     
158.         (vl-some
     
159.           (function
     
160.             (lambda ( file )
     
161.               (vl-catch-all-apply 'vla-load (list aclts lt file))
     
162.               (and (tblsearch "LTYPE" lt))
     
163.             )
     
164.           )
     
165.           (setq *LineTypeDefs*
     
166.             (cond
     
167.               ( *LineTypeDefs* )
     
168.               ( (apply 'append
     
169.                   (mapcar '(lambda ( directory ) (vl-directory-files directory "*.lin" 1))
     
170.                     (LM:str->lst
     
171.                       (vla-get-SupportPath (vla-get-Files (vla-get-Preferences acapp))) ";"
     
172.                     )
     
173.                   )
     
174.                 )
     
175.               )
     
176.             )
     
177.           )
     
178.         )
     
179.       )
     
180.     )
     
181.   )  
     
182. )
     
183. 
     
184. ;;-------------------=={ String to List }==-------------------;;
     
185. ;;                                                            ;;
     
186. ;;  Separates a string into a list of strings using a         ;;
     
187. ;;  specified delimiter string                                ;;
     
188. ;;------------------------------------------------------------;;
     
189. ;;  Author: Lee Mac, Copyright &#169; 2011     ;;
     
190. ;;------------------------------------------------------------;;
     
191. ;;  Arguments:                                                ;;
     
192. ;;  str - string to process                                   ;;
     
193. ;;  del - delimiter by which to separate the string           ;;
     
194. ;;------------------------------------------------------------;;
     
195. ;;  Returns:  A list of strings                               ;;
     
196. ;;------------------------------------------------------------;;
     
197. 
     
198. (defun LM:str->lst ( str del / pos )
     
199.   (if (setq pos (vl-string-search del str))
     
200.     (vl-remove "" (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del)))
     
201.     (list str)
     
202.   )
     
203. )

(defun c:MakeLayers nil (vl-load-com)  <br />   ;; &#169; Lee Mac 2010<br /> <br />   ;;----------------------------------------------------------------------------------------------;;<br />   ;; Specifications:                                                                              ;;<br />   ;;----------------------------------------------------------------------------------------------;;<br />   ;; Description         Data Type       Remarks                                                  ;;<br />   ;;----------------------------------------------------------------------------------------------;;<br />   ;; Layer Name          STRING          Only standard chars allowed.                             ;;<br />   ;; Layer Colour        INTEGER         may be nil, -ve for Layer Off, Colour < 256              ;;<br />   ;; Layer Linetype      STRING          may be nil, If not loaded, CONTINUOUS.                   ;;<br />   ;; Layer Lineweight    REAL            may be nil, negative=Default, otherwise 0 <= x <= 2.11   ;;<br />   ;; Plot?               BOOLEAN         T = Plot Layer, nil otherwise                            ;;<br />   ;; Bit Flag            INTEGER         0=None, 1=Frozen, 2=Frozen in VP, 4=Locked               ;;<br />   ;; Description         STRING          may be nil for no description                            ;;<br />   ;;----------------------------------------------------------------------------------------------;;<br />   ;; Function will print list detailing any unsuccesful layers                                    ;;<br />   ;;----------------------------------------------------------------------------------------------;;<br />     <br />   (regapp "AcAecLayerStandard")<br /> <br />   (<br />     (lambda ( lst )<br />       (mapcar 'print<br />         (vl-remove-if 'cdr<br />           (mapcar<br />             (function<br />               (lambda ( x )<br />                 (if (caddr x) (LM:LoadLinetype (caddr x))) (cons (car x) (apply 'MakeLayer x))<br />               )<br />             )<br />             lst<br />           )<br />         )<br />       )<br />     )<br />    '(<br />     ;  Name                 Colour   Linetype    Lineweight Plot? Bitflag  Description <br />     ( "EL_COMPONENTS"            7  "CONTINUOUS"     -3       T      0     "componets")<br />     ( "EL_CONSTR_COMP"           1  "CONTINUOUS"     -3       T      0     "const"    )<br />     ( "EL_FITTINGS"              4  "CONTINUOUS"     -3       T      0     "fitting"  )<br />     ( "EL_LABEL"                 1  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "EL_LABEL_TXT"           252  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "EL_TERMINALS"             1  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "EL_TERMINALS_PE"         24  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "EL_TERMINALS_TXT"       252  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "EL_TXT"                 252  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "EL_WIRES"               252  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "GE_ANNOTATION"            7  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "GE_LABEL"                10  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "GE_LABEL_TEXT"          253  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "GE_TXT_LANGUAGE_DU"     252  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "GE_TXT_LANGUAGE_EN"     252  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "GE_TXT_LANGUAGE_FR"     252  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "GE_TXT_LANGUAGE_GE"     252  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "LA_HEADER_FRAME"          7  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "LA_HEADER_TXT"            7  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "LA_MATLIST"             254  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "LA_MATLIST_FRAME"       254  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "LA_MATLIST_POS"         254  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "LA_MATLIST_TXT"         252  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "LA_TITLE_FRAME"           7  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "LA_TITLE_LOGO"           10  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "LA_TITLE_LOGO_TXT"        7  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "LA_TITLE_TXT"             7  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "LA_VIEWPORTS"           230  "CONTINUOUS"     -3      nil     0      nil  )<br />     ( "PN_ACCESSORIES"          30  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_ACTUATORS"           160  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_AIR_LINE_EQUIPMENT"   40  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_BRACKET_MOUNTING"      1  "ACAD_ISO12W100" -3       T      0      nil  )<br />     ( "PN_CABINET"               8  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_CABINET_DIM"           8  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_COMPONENTS"            7  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_CONDUCTS"              3  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_CONSTR_COMP"           2  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_DRAIN"                 3  "HIDDEN"         -3       T      0      nil  )<br />     ( "PN_EXHAUST"             104  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_FITTINGS"             30  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_IDENTIFICATION"        4  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_PILOT_SUPPLY"          3  "HIDDEN"         -3       T      0      nil  )<br />     ( "PN_PORT_NUMBERS"          8  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_PRESSURE_SWITCHES"   200  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_PROPORTIONAL_VALVES" 226  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_SECTIONS"              3  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_SUB-BASES"             8  "ACAD_ISO12W100" -3       T      0      nil  )<br />     ( "PN_SUB-BASE_CONDUCTS"     2  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_SUPPLY"                3  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_TXT"                   3  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_VACUUM"               60  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_VALVES"              240  "CONTINUOUS"     -3       T      0      nil  )<br />     ( "PN_VALVES_OVERRIDE"       1  "CONTINUOUS"     -3       T      0      nil  )<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> (defun MakeLayer ( name colour linetype lineweight willplot bitflag description )<br />   ;; &#169; Lee Mac 2010<br />   (or (tblsearch "LAYER" name)<br />     (entmake<br />       (append<br />         (list<br />           (cons 0 "LAYER")<br />           (cons 100 "AcDbSymbolTableRecord")<br />           (cons 100 "AcDbLayerTableRecord")<br />           (cons 2  name)<br />           (cons 70 bitflag)<br />           (cons 290 (if willplot 1 0))<br />           (cons 6<br />             (if (and linetype (tblsearch "LTYPE" linetype))<br />               linetype "CONTINUOUS"<br />             )<br />           )<br />           (cons 62 (if (and colour (< 0 (abs colour) 256)) colour 7))<br />           (cons 370<br />             (if (minusp lineweight) -3<br />               (fix<br />                 (* 100<br />                   (if (and lineweight (<= 0.0 lineweight 2.11)) lineweight 0.0)<br />                 )<br />               )<br />             )<br />           )<br />         )<br />         (if description<br />           (list<br />             (list -3<br />               (list "AcAecLayerStandard" (cons 1000 "") (cons 1000 description))<br />             )<br />           )<br />         )<br />       )<br />     )<br />   )<br /> )<br /> <br /> ;;--------------------=={ Load Linetype }==-------------------;;<br /> ;;                                                            ;;<br /> ;;  Attempts to load a specified linetype from any linetype   ;;<br /> ;;  definition files (.lin) found in the ACAD Support Path    ;;<br /> ;;------------------------------------------------------------;;<br /> ;;  Author: Lee Mac, Copyright &#169; 2011    ;;<br /> ;;------------------------------------------------------------;;<br /> ;;  Arguments:                                                ;;<br /> ;;  lt - name of linetype to load                             ;;<br /> ;;------------------------------------------------------------;;<br /> ;;  Returns:  T if linetype loaded successfully, else nil     ;;<br /> ;;------------------------------------------------------------;;<br /> <br /> (defun LM:LoadLinetype ( lt )<br />   (cond<br />     ( (tblsearch "LTYPE" lt) )<br />     ( (progn<br />         (or acapp (setq acapp (vlax-get-acad-object)))<br />         (or acdoc (setq acdoc (vla-get-ActiveDocument acapp)))<br />         (or aclts (setq aclts (vla-get-Linetypes acdoc)))<br /> <br />         (vl-some<br />           (function<br />             (lambda ( file )<br />               (vl-catch-all-apply 'vla-load (list aclts lt file))<br />               (and (tblsearch "LTYPE" lt))<br />             )<br />           )<br />           (setq *LineTypeDefs*<br />             (cond<br />               ( *LineTypeDefs* )<br />               ( (apply 'append<br />                   (mapcar '(lambda ( directory ) (vl-directory-files directory "*.lin" 1))<br />                     (LM:str->lst<br />                       (vla-get-SupportPath (vla-get-Files (vla-get-Preferences acapp))) ";"<br />                     )<br />                   )<br />                 )<br />               )<br />             )<br />           )<br />         )<br />       )<br />     )<br />   )  <br /> )<br /> <br /> ;;-------------------=={ String to List }==-------------------;;<br /> ;;                                                            ;;<br /> ;;  Separates a string into a list of strings using a         ;;<br /> ;;  specified delimiter string                                ;;<br /> ;;------------------------------------------------------------;;<br /> ;;  Author: Lee Mac, Copyright &#169; 2011     ;;<br /> ;;------------------------------------------------------------;;<br /> ;;  Arguments:                                                ;;<br /> ;;  str - string to process                                   ;;<br /> ;;  del - delimiter by which to separate the string           ;;<br /> ;;------------------------------------------------------------;;<br /> ;;  Returns:  A list of strings                               ;;<br /> ;;------------------------------------------------------------;;<br /> <br /> (defun LM:str->lst ( str del / pos )<br />   (if (setq pos (vl-string-search del str))<br />     (vl-remove "" (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del)))<br />     (list str)<br />   )<br /> )

davide888

记得有通过文本和通过EXCEL文件方式创建的，有源码

【KAIXIN】

sachindkini 发表于 2015-4-6 21:18

写的够谨慎