社区 › Auto Lisp › Lisp生成层。线宽0

Sittingbull 发表于 2022-7-6 09:10:04

Lisp生成层。线宽0

大家好，
 
 
我正在使用Mac Lee的Makalayer例程使用lisp创建层。
 
(defun MakeLayer ( name colour linetype lineweight willplot bitflag description )
;; © Lee Mac 2010
(or (tblsearch "LAYER" name)
   (entmake
   (append
       (list
         (cons 0 "LAYER")
         (cons 100 "AcDbSymbolTableRecord")
         (cons 100 "AcDbLayerTableRecord")
         (cons 2name)
         (cons 70 bitflag)
         (cons 290 (if willplot 1 0))
         (cons 6
         (if (and linetype (tblsearch "LTYPE" linetype))
             linetype "CONTINUOUS"
         )
         )
         (cons 62 (if (and colour (< 0 (abs colour) 256)) colour 7))
         (cons 370
         (fix
             (* 100
               (if (and lineweight (<= 0.0 lineweight 2.11)) lineweight 0.0)
             )
         )
         )
       )
       (if description
         (list
         (list -3
             (list "AcAecLayerStandard" (cons 1000 "") (cons 1000 description))
         )
         )
       )
   )
   )
)
)
(defun c:norlays nil (vl-load-com)
;; © Lee Mac 2010
;; Specifications:
;; Description      Data Type      Remarks
;; -----------------------------------------------------------------
;; Layer Name          STRING          Only standard chars allowed
;; Layer Colour      INTEGER         may be nil, -ve for Layer Off, Colour < 256
;; Layer Linetype      STRING          may be nil, If not loaded, CONTINUOUS.
;; Layer Lineweight    REAL            may be nil, 0 <= x <= 2.11
;; Plot?               BOOLEAN         T = Plot Layer, nil otherwise
;; Bit Flag            INTEGER         0=None, 1=Frozen, 2=Frozen in VP, 4=Locked
;; Description         STRING          may be nil for no description
;; Function will return list detailing whether layer creation is successful.   
(
   (lambda ( lst / lts ) (setq lts (vla-get-Linetypes (vla-get-ActiveDocument (vlax-get-acad-object))))
   (mapcar 'cons (mapcar 'car lst)
       (mapcar
         (function
         (lambda ( x )
             (and (caddr x)
               (or (tblsearch "LTYPE" (caddr x))
               (vl-catch-all-apply 'vla-load (list lts (caddr x) "acad.lin"))
               )
             )
             (apply 'MakeLayer x)
         )
         )
         lst
       )
   )
   )
'(
   ;Name    Colour   Linetype Lineweight Plot? Bitflag      Description
   ( "EL_COMPONENTS"   7"CONTINUOUS" DefaultT 0nil)
   ( "EL_CONSTR_COMP"1"CONTINUOUS" DefaultT 0nil)
   ( "EL_FITTINGS"   4"CONTINUOUS" DefaultT 0nil)
   ( "EL_LABEL"   1"CONTINUOUS" DefaultT 0nil)
   ( "EL_LABEL_TXT"   252"CONTINUOUS" DefaultT 0nil)
   ( "EL_TERMINALS"   1"CONTINUOUS" DefaultT 0nil)
   ( "EL_TERMINALS_PE"24"CONTINUOUS" DefaultT 0nil)
   ( "EL_TERMINALS_TXT"252"CONTINUOUS" DefaultT 0nil)
   ( "EL_TXT"   252"CONTINUOUS" DefaultT 0nil)
   ( "EL_WIRES"   252"CONTINUOUS" DefaultT 0nil)
   ( "GE_ANNOTATION"   7"CONTINUOUS" DefaultT 0nil)
   ( "GE_LABEL"   10"CONTINUOUS" DefaultT 0nil)
   ( "GE_LABEL_TEXT"   253"CONTINUOUS" DefaultT 0nil)
   ( "GE_TXT_LANGUAGE_DU"252"CONTINUOUS" DefaultT 0nil)
   ( "GE_TXT_LANGUAGE_EN"252"CONTINUOUS" Default      T 0nil)
   ( "GE_TXT_LANGUAGE_FR"252"CONTINUOUS" Default      T 0nil)
   ( "GE_TXT_LANGUAGE_GE"252"CONTINUOUS" Default      T 0nil)
   ( "LA_HEADER_FRAME"7"CONTINUOUS" Default      T 0nil)
   ( "LA_HEADER_TXT"   7"CONTINUOUS" Default      T 0nil)
   ( "LA_MATLIST"   254"CONTINUOUS" Default      T 0nil)
   ( "LA_MATLIST_FRAME"254"CONTINUOUS" Default      T 0nil)
   ( "LA_MATLIST_POS"254"CONTINUOUS" Default      T 0nil)
   ( "LA_MATLIST_TXT"252"CONTINUOUS" Default      T 0nil)
   ( "LA_TITLE_FRAME"7"CONTINUOUS" Default      T 0nil)
   ( "LA_TITLE_LOGO"   10"CONTINUOUS" Default      T 0nil)
   ( "LA_TITLE_LOGO_TXT"7"CONTINUOUS" Default      T 0nil)
   ( "LA_TITLE_TXT"   7"CONTINUOUS" Default      T 0nil)
   ( "LA_VIEWPORTS"   230"CONTINUOUS" Default      nil 0nil)
   ( "PN_ACCESSORIES"30"CONTINUOUS" Default      T 0nil)
   ( "PN_ACTUATORS"   160"CONTINUOUS" Default      T 0nil)
   ( "PN_AIR_LINE_EQUIPMENT"40"CONTINUOUS" Default      T 0nil)
   ( "PN_BRACKET_MOUNTING"1"ACAD_ISO12W100"Default      T 0nil)
   ( "PN_CABINET"   8"CONTINUOUS" Default      T 0nil)
   ( "PN_CABINET_DIM"8"CONTINUOUS" Default      T 0nil)
   ( "PN_COMPONENTS"   7"CONTINUOUS" Default      T 0nil)
   ( "PN_CONDUCTS"   3"CONTINUOUS" Default      T 0nil)
   ( "PN_CONSTR_COMP"2"CONTINUOUS" Default      T 0nil)
   ( "PN_DRAIN"   3"HIDDEN" Default      T 0nil)
   ( "PN_EXHAUST"   104"CONTINUOUS" Default      T 0nil)
   ( "PN_FITTINGS"   30"CONTINUOUS" Default      T 0nil)
   ( "PN_IDENTIFICATION"4"CONTINUOUS" Default      T 0nil)
   ( "PN_PILOT_SUPPLY"3"HIDDEN" Default      T 0nil)
   ( "PN_PORT_NUMBERS"8"CONTINUOUS" Default      T 0nil)
   ( "PN_PRESSURE_SWITCHES"200"CONTINUOUS" Default      T 0nil)
   ( "PN_PROPORTIONAL_VALVES" 226"CONTINUOUS" Default      T 0nil)
   ( "PN_SECTIONS"   3"CONTINUOUS" Default      T 0nil)
   ( "PN_SUB-BASES"   8"ACAD_ISO12W100"Default      T 0nil)
   ( "PN_SUB-BASE_CONDUCTS"2"CONTINUOUS" Default      T 0nil)
   ( "PN_SUPPLY"   3"CONTINUOUS" Default      T 0nil)
   ( "PN_TXT"   3"CONTINUOUS" Default      T 0nil)
   ( "PN_VACUUM"   60"CONTINUOUS" Default      T 0nil)
   ( "PN_VALVES"   240"CONTINUOUS" Default      T 0nil)
   ( "PN_VALVES_OVERRIDE"1"CONTINUOUS" Default      T 0nil)
   )
)
)
 
用于加载线型：
 
（“隐藏”林）
)
（foreach lin行列表
（或（tblsearch“LTYPE”（car lin））
（命令“.-linetype”“\u Load”（car lin）（cdr lin）”）
)
)
（普林斯）
); 端ln\u负载函数

Sittingbull 发表于 2022-7-6 09:15:23

我倾向于使用它来加载线型

Lee Mac 发表于 2022-7-6 09:19:36

大家好，
 
代码运行良好，直到我开始使用以ISO开头的层。
不知道为什么，但在某些文件上运行lisp时，它只创建线型，而不创建图层。
如果我只做一个层，平均名称，没关系，lisp再次工作。
我添加了一个文件，它是acadiso的副本。dwt模板。
 
下面是我使用的层的代码：
 
 
2
 
代码中应正确引用线定义文件。
不要使用“描述”-那里有一个bug

Sittingbull 发表于 2022-7-6 09:22:26

啊。。。
该死
谢谢你的提示。

Lee Mac 发表于 2022-7-6 09:23:36

事实上，删掉描述就行了。太糟糕了。

rhino 发表于 2022-7-6 09:28:57

请试用附件中的“MakeLayers”
MakeLayers。lsp

Lee Mac 发表于 2022-7-6 09:29:21

我想我不知道怎么触发它。
在（加载“makelayers”）上，什么都不会发生。
所以我试着，LM:STR->LST，LM，STR->LST，。。。我看不出有什么反应。。。

Sittingbull 发表于 2022-7-6 09:34:24

 
str->lst只是一个子功能，使用“MakeLayers”（在顶部定义）-我应该添加一条加载消息。
 
你可能会喜欢这个新奇的节目：
 
http://lee-mac.com/getsyntax.html

rhino 发表于 2022-7-6 09:38:06

2011年新图纸的工作进展良好。
但与旧图纸不同（我认为是2004年）
 
[附件]26294
 
带有描述的一些图层：
 
isolays。lsp

Sittingbull 发表于 2022-7-6 09:41:27

 
 
李，在getsyntax中。lsp程序，如何定义一个唯一的搜索目录，而不是默认的，在我的情况下，是C:\users\something\documents？
换句话说，它可以被设置或硬编码为用户想要的任何内容吗？哪个应该是保存所有LISP的目录？
thx，史蒂夫

查看完整版本: Lisp生成层。线宽0