社区 › Auto Lisp › 检查/创建图层问题

MarcoW 发表于 2022-7-6 14:28:45

检查/创建图层问题

我想做一个惯例：
 
1.检查线型是否已加载，如果未加载，则应加载，如果是，则确定
 
2.检查层是否存在，如果没有创建（具有特定颜色和线型），如果是，则将其设置为当前。
 
这是我的代码：
 

(defun c:test ( / ltname layname laycol cmdold) ; functie definitie
(setq ltname "center"; defines linetypename
layname "test"   ; defines layername
laycol 8   ; defines layer color
cmdold (getvar "cmdecho")
)   ; end setq
(setvar "cmdecho" 0   ; no following by F2
)   ; end setvar

(if (= (tblsearch "ltype" ltname) nil)
(command "linetype" "l" ltname "acad.lin" "")
)
(if (= (tblsearch "layer" layname))
(command "layer" "s" layname "")
(command "layer" "m" layname "l" ltname "" "c" laycol "" "")
)
(setvar "cmdecho" cmdold); cmdecho back to what it was
(princ); Exit cleanly
); end of defun

 
问题是当层存在时，它不会将其设置为当前。。。
 
我离我相信的解决方案只有一英寸远。。。。但我做不到。

Lee Mac 发表于 2022-7-6 14:33:36

如果您还想走这条路线，我提供了一个VL选项：
 

(defun c:test (/ ltname layname laycol cmdold lay)
(vl-load-com)
(setq ltname "center"
       layname "test"
       laycol 8
       cmdold (getvar "CMDECHO"))
(setvar "CMDECHO" 0)

;; Loading Linetype~ Another option to consider:

(if (not (tblsearch "LTYPE" ltname))
   (vla-load
   (vla-get-Linetypes
       (vla-get-ActiveDocument
         (vlax-get-acad-object))) ltname "acad.lin"))

;; Layer Checking & Creation

(if (not (tblsearch "LAYER" layname))
   (command "_.-layer" "_M" layname "_L" ltname layname "_C" laycol layname "")
   (setvar "CLAYER" layname))

;; Another Option for Layer Creation to Consider:

(if (not (tblsearch "LAYER" layname))
   (progn
   (setq lay (vla-add
               (vla-get-layers
                   (vla-get-ActiveDocument
                     (vlax-get-acad-object))) layname))
   (vla-put-color lay laycol)
   (vla-put-linetype lay ltname)))
(setvar "CLAYER" layname)

;; Reset CMDECHO

(setvar "CMDECHO" cmdold)
(princ))


            

MarcoW 发表于 2022-7-6 14:37:17

李，
 
虽然我没有得到代码，但它工作正常。这太过分了，所以让我们把这部分留给它是什么。
 
此示例（测试lsp）适用于1层、1线型和1种颜色。
我想知道它是否可以制作成多层。不是以我现在的方式，那是错误的，很明显！
 
我复制代码10次，并将c:test更改为c:test1 c:test2等。然后根据函数修改名称。
对于特定层的test1调用，我不知道如何执行其他操作。

Lee Mac 发表于 2022-7-6 14:39:37

代码没有那么复杂的解释-我可以尝试回答任何问题，你可能有关于它。
 
对于多层、颜色等-将层函数变成子函数，并用多个参数调用它：
 

(defun mklay (layname laycol ltname / lay)
(vl-load-com)

;; Loading Linetype~ Another option to consider:

(if (not (tblsearch "LTYPE" ltname))
   (vla-load
   (vla-get-Linetypes
       (vla-get-ActiveDocument
         (vlax-get-acad-object))) ltname "acad.lin"))

;; Another Option for Layer Creation to Consider:

(if (not (tblsearch "LAYER" layname))
   (progn
   (setq lay (vla-add
               (vla-get-layers
                   (vla-get-ActiveDocument
                     (vlax-get-acad-object))) layname))
   (vla-put-color lay laycol)
   (vla-put-linetype lay ltname)))
(setvar "CLAYER" layname))



(defun c:test ()
(mapcar 'mklay
         '("test1" "test2" "test3")
         '(8 3 4)
         '("CENTER" "HIDDEN" "CONTINUOUS"))
(princ))

 
这将形成三层：
 
测试1——颜色8——中心
测试2——颜色3——隐藏
测试3——颜色4——连续
 
希望这有帮助，
 
李

TimSpangler 发表于 2022-7-6 14:42:29

这是我一直使用的线型加载子对象，以及辅助子对象。
 
只要给它一个线型名称，它就会搜索每一个。林文件在您的搜索路径，如果它找到它，它会被加载。
 
我想对其执行的唯一操作是，如果提供了路径，则直接加载线型。
STDLIB_LOAD_线型。lsp
STDLIB_函数。lsp

bradb 发表于 2022-7-6 14:46:35

这里有一个我使用它清除所有未使用的层，然后创建我使用的10层。您可以根据自己的喜好修改图层名称，并且可以在dolayers命令的末尾进行修改以将图层设置为当前图层。
 
（setvar“clayer”“在此插入层名称”）
 
我知道它的rokkie编程，但它对我来说很管用。我用它来确保我们所有的图纸都有相同的图层，因为我是这里的第四个绘图员，我们有很多不同的图纸。
 
哦，谢谢李，我在他的一个命令中看到了类似的东西，所以我只是做了一些修改。
 

(defun createlayer (NAME)
(if
(not (tblsearch "LAYER" NAME))
(command "-layer" "m" "CEN" "C" "6" "CEN" "L" "CENTER" "CEN" "LW" "0.18" "CEN" "")
)
(if
(not (tblsearch "LAYER" NAME))
(command "-layer" "m" "DIMS" "C" "1" "DIMS" "LW" "0.18" "DIMS" "")
)
(if
(not (tblsearch "LAYER" NAME))
(command "-layer" "m" "HAT" "C" "3" "HAT" "LW" "0.18" "HAT" "")
)
(if
(not (tblsearch "LAYER" NAME))
(command "-layer" "m" "HID" "C" "4" "HID" "L" "HIDDEN" "HID" "LW" "0.15" "HID" "")
)
(if
(not (tblsearch "LAYER" NAME))
(command "-layer" "m" "LOGO" "C" "176" "LOGO" "LW" "0.09" "" "")
)
(if
(not (tblsearch "LAYER" NAME))
(command "-layer" "m" "OBJ" "C" "2" "OBJ" "LW" "0.40" "OBJ" "")
)
(if
(not (tblsearch "LAYER" NAME))
(command "-layer" "m" "PAPER" "C" "5" "PAPER" "L" "PHANTOM" "PAPER" "P" "N" "PAPER" "")
)
(if
(not (tblsearch "LAYER" NAME))
(command "-layer" "m" "PHAN" "C" "6" "PHAN" "L" "PHANTOM" "PHAN" "LW" "0.18" "PHAN" "")
)
(if
(not (tblsearch "LAYER" NAME))
(command "-layer" "m" "TITLE" "C" "176" "TITLE" "")
)
(if
(not (tblsearch "LAYER" NAME))
(command "-layer" "m" "TXT" "C" "7" "" "")
)
)

(defun c:dolayers ()
(setvar "cmdecho" 0)
(purgelayers)
(mapcar 'createlayer '("CEN" "DIMS" "HAT" "HID" "LOGO" "OBJ" "PAPER" "PHAN" "TITLE" "TXT"))
)

Lee Mac 发表于 2022-7-6 14:49:10

 
Bradb，
 
按照调用子函数的方式，每个语句都独立于提供的参数。一、 e.对于每个不存在的层，每个IF语句都将返回T。

bradb 发表于 2022-7-6 14:51:41

 
啊，这是因为我在创建层之前清除了所有层。我最初希望它搜索层，然后重命名它们。例如，搜索对象和对象。对象重命名为OBJ。如果OBJ，那么什么也不会发生，但如果两者都不存在，那么就创建OBJ。

The Buzzard 发表于 2022-7-6 14:56:21

您应该只对一个参数进行一次表搜索，并使用条件生成层。

Lee Mac 发表于 2022-7-6 14:59:48

不，这是因为您为每个IF语句提供了相同的参数。
 
这更好（更快）：
 

(defun MkLay (Nme Col lTyp lWgt Plt / lay)
(vl-load-com)
(setq lay
   (vla-add
   (vla-get-layers
       (vla-get-ActiveDocument
         (vlax-get-acad-object))) Nme))
(and Col (vla-put-Color lay Col))
(and lTyp (vla-put-Linetype lay lTyp))
(and lWgt (vla-put-LineWeight lay lWgt))
(and (not Plt) (vla-put-Plottable lay :vlax-false)))

(defun c:DoLayers ()
(purgelayers)
(mapcar 'MkLay
         '( "CEN"   "DIMS" "HAT""HID"   "LOGO" "OBJ""PAPER"   "PHAN"   "TITLE" "TXT"); Name
         '(   6       1      3      4       176    2       5         6       176   7); Colours
         '("CENTER"nil    nil"HIDDEN"   nil   nil"PHANTOM" "PHANTOM"   nil    nil ); LineType
         '(0.18   0.18   0.18    0.15    0.090.40   nil      0.18      nil    nil ); LineWeight
         '(   T       T      T      T      T   T      nil      T      T      T)) ; Plottable (T or nil)
(princ))
         

我不确定你的“purgelayers”函数做什么，但也许我也可以改进一下

查看完整版本: 检查/创建图层问题