我建议修改你的层命令,使它更有效一点。我无法判断代码中的错误是什么,因为它似乎已正确关闭。
以下是我们使用的内容:
- ;;2010.11.04 Layer Setup by Christopher T. Cowgill ;;
- ;;Truecolor function by Fred Tomke (www.theswamp.org) ;;
- ;;Coding assistance provided by Opie, RobertB, and irneb (www.augi.com), ronjonp ;;
- ;;Original code simplification by alanjt (www.augi.com, www.theswamp.org) ;;
- ;;****************************************************************************************************************************************
- (defun truecolor (uColor / oColor)
- (setq oColor (vla-getinterfaceobject acadObject "AutoCAD.AcCmColor.18"))
- (cond
- ((= (type uColor) 'INT)
- (vla-put-ColorMethod oColor acColorMethodByACI)
- (vla-put-ColorIndex oColor uColor)
- )
- ((not (listp uColor)) nil)
- ((= (length uColor) 3)
- (vla-put-ColorMethod oColor acColorMethodByRGB)
- (vla-SetRGB oColor (car uColor) (cadr uColor) (last uColor))
- )
- ((= (length uColor) 2)
- (vla-SetColorBookColor oColor (car uColor) (cadr uColor))
- )
- ) ; cond
- ocolor
- ) ; truecolor
- ;;****************************************************************************************************************************************
- (defun alllayerset (lst / listlayer name match)
- (command "linetype" "_load" "*" "acad" "")
- (command "-layer" "SET" "0" "")
- (setq listlayer (vla-get-layers acaddocument))
- (foreach y lst
- (if (wcmatch (car y) "*`**")
- ()
- (if (tblsearch "LAYER" (car y))
- ()
- (vla-add listlayer (car y))
- ) ;_ end of if
- ) ;_ end of if
- ) ;_ end of foreach
- (vlax-for x listlayer
- (or (vl-position (setq name (strcase (vla-get-name x))) '("0" "DEFPOINTS"))
- (if (setq match (vl-remove-if-not
- (function (lambda (x) (wcmatch name (strcase (car x)))))
- lst
- ) ;_ end of vl-remove-if-not
- ) ;_ end of setq
- (mapcar (function
- (lambda (p v)
- (if v
- (vl-catch-all-apply
- (function vlax-put-property)
- (list x p v)
- ) ;_ end of vl-catch-all-apply
- ) ;_ end of if
- ) ;_ end of lambda
- ) ;_ end of function
- '(Freeze Color LineType Plottable Description Truecolor)
- (cdar match)
- ) ;_ end of mapcar
- ) ;_ end of if
- ) ;_ end of or
- ) ;_ end of vlax-for
- (setq name nil)
- (vla-regen acadDocument acAllViewports)
- ) ;_ end of defun
我只需要向程序提供一个层及其属性的列表,它就可以处理其余的所有内容。 |