要记住的事情。 这将加载未加载的线型
(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 (lTload lTyp) (vla-put-Linetype lay lTyp))
(and lWgt(vla-put-LineWeight lay lWgt))
(and (not Plt) (vla-put-Plottable lay :vlax-false)))
(defun lTload (lTyp)
(or (tblsearch "LTYPE" lTyp)
(vla-load
(vla-get-Linetypes
(vla-get-ActiveDocument
(vlax-get-acad-object))) lTyp "acad.lin")))
(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))
(defun purgelayers ()
(command "-purge" "LA" "" "N")
)
这是purgelayers，他们知道我以前没有抄过。基本上，我想清除所有不是lisp中提供的层名称的层 李跑了你的，唯一的事情是没有拿起线宽。所有图层设置均设置为执行linewieght设置为0.00
将检查-
你注意到速度差了吗？ 好的，这应该可以：
(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 (lTload lTyp) (vla-put-Linetype lay lTyp))
(and lWgt(vla-put-LineWeight lay (eval (read (strcat "acLnWt" lWgt)))))
(and (not Plt) (vla-put-Plottable lay :vlax-false)))
(defun lTload (lTyp)
(or (tblsearch "LTYPE" lTyp)
(vla-load
(vla-get-Linetypes
(vla-get-ActiveDocument
(vlax-get-acad-object))) lTyp "acad.lin"))
t)
(defun c:DoLayers (/ cm)
(vl-load-com)
(setq cm (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(vl-cmdf "_.-purge" "_LA" "*" "_N")
(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
'( "018" "018""018""015" "009" "040" nil "018" nil nil ); LineWeight 0.18 = "018"
'( T T T T T T nil T T T)) ; Plottable (T or nil)
(setvar "CMDECHO" cm)
(princ))
李，这就是我的解决方案。
我想在插入特定块时创建一个特定层，即在层“box”、线型中心、设置为非打印的层中插入一个名为“box”的块，我使用内部菜单中的宏：
^C^Ccreatelayer;Center;m_boxes;3;n;
这是打开图形时启动的lisp：
(defun c:createlayer (/ ltname layname laycol cmdold lay)
(vl-load-com)
(setq ltname (getstring "\nPlease enter the name of the linetype: ")
layname (getstring "\nPlease enter the name of the layer: ")
laycol (getint "\nPlease enter the colour of the layer: ")
layplot (getstring "\nDo you want the layer to be <Plot> or <Non plot>: ")
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 "_P" layplot "" "")
(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))
所以现在我在宏中指定层，这给了我很大的灵活性，每当有一种新的块要插入时，我就创建层。。。
但是所有的功劳都要归功于李，没有你的帮助，我是不可能做到的。
是的，李，快一点谢谢
哦，你使用的vl-load-com和vla是什么？
它们是Visual LISP方法-AfraLISP有很多关于它们的信息
谢谢Marco，
但请记住，对于您的代码，您有两个部分做相同的事情。-您可能需要考虑删除一个。
页:
1
[2]