表格图层选择
你好我刚刚分配了编写宏的任务，该宏在运行时需要打开一个表，允许用户从下拉菜单中选择一个选项。选择后，宏需要在运行宏的图形中打开和关闭图层。如果您能提供任何帮助，我们将不胜感激。
非常感谢。 将组合框添加到表单。要让它做出选择，请执行以下操作
With CmbBox
.AddItem "qty 1", 0
.AddItem "qty 2", 1
.AddItem "qty 3", 2
.AddItem "qty 4", 3
.ListIndex = 0
End With
这是我在浏览这个网站时发现的代码。该代码是否可以用于制作允许制作层选择选项的表单？
我相信这是ASMI发布的。
(defun c:patlay(/ oldPat cFlag lLst Ans actDoc aName oldLay)
(vl-load-com)
(defun StoreLayerStates()
(setq patlay:layerstate nil)
(vlax-for l(vla-get-Layers actDoc)
(setq patlay:layerstate
(append patlay:layerstate
(list
(list l
(vla-get-LayerOn l)
(vla-get-Lock l)
(vla-get-Freeze l)
); end list
); end list
); end apend
); end setq
); end vlax-for
(princ)
); end of StoreLayerStates
(if(not laypat:pat)(setq laypat:pat ""))
(setq oldPat laypat:pat)
(while(not cFlag)
(setq laypat:pat(getstring T
(strcat "\nLayer name pattern or <"
laypat:pat ">: ")))
(cond
((member laypat:pat '("H" "h" "_H" "_h" "Help" "HELP" "help"))
(princ "\n <<< PATTERNS AVAILABLE >>> \n")
(princ "\n # - Matches any single numeric digit.")
(princ "\n @ - Matches any single alphabetic character.")
(princ "\n . - Matches any single nonalphanumeric character.")
(princ "\n * - Matches any character sequence, including an ")
(princ "\n empty one, and it can be used anywhere in the ")
(princ "\n search pattern at the beginning, middle, or end.")
(princ "\n ? - Matches any single character \n")
(princ "\n ~ - If it is the first character in the pattern,")
(princ "\n it matches anything except the pattern.")
(princ "\n [...] - Matches any one of the characters enclosed.")
(princ "\n [~...] - Matches any single character not enclosed.")
(princ "\n - - Used inside brackets to specify a range.")
(princ "\n for a single character.")
(princ "\n , - Separates two patterns.")
(princ "\n ` - Escapes special characters (reads next")
(princ "\n character literally).")
(princ "\n\nPress F2 to close text scren...\n")
(textscr)
); end condition #1
((member laypat:pat '("Q" "q" "_Q" "_q" "Quit" "QUIT" "quit"))
(setq cFlag T laypat:pat "")
); end condition #2
((= laypat:pat "")
(setq laypat:pat oldPat cFlag T)
); end condition #3
(t
(setq cFlag T)
); end condition #4
); end cond
); end while
(if(/= laypat:pat "")
(progn
(setq lLst '()
actDoc(vla-get-ActiveDocument
(vlax-get-acad-object))
); end setq
(vlax-for l(vla-get-Layers actDoc)
(if(wcmatch(strcase(vla-get-Name l))(strcase laypat:pat))
(setq lLst(append lLst(list l)))
); end if
); end vlax-for
(if lLst
(progn
(princ(strcat "\n>>> Layers found ("(itoa(length lLst))"): "))
(princ(strcat (vla-get-Name(car lLst))))
(foreach l(cdr lLst)
(princ(strcat ", "(vla-get-Name l)))
); end foreach
(setq Ans "lIst")
(while(or(= Ans "lIst")(= Ans "Highlight"))
(initget "On ofF Lock Unlock fReeze Thaw Isolate Previouos Highlight Quit")
(setq Ans
(getkword
"\nSelect option : "))
(vla-StartUndoMark actDoc)
(cond
((= "On" Ans)
(StoreLayerStates)
(mapcar '(lambda(l)(vla-put-LayerON l :vlax-true))lLst)
); end condition #2
((= "ofF" Ans)
(StoreLayerStates)
(mapcar '(lambda(l)(vla-put-LayerON l :vlax-false))lLst)
); end condition #3
((= "Lock" Ans)
(StoreLayerStates)
(mapcar '(lambda(l)(vla-put-Lock l :vlax-true))lLst)
); end condition #4
((= "Unlock" Ans)
(StoreLayerStates)
(mapcar '(lambda(l)(vla-put-Lock l :vlax-false))lLst)
); end condition #5
((= "fReeze" Ans)
(StoreLayerStates)
(mapcar '(lambda(l)(if(not(member(vla-get-Name l)
(list
(vla-get-Name
(vla-get-ActiveLayer actDoc))
"0")))
(vla-put-Freeze l :vlax-true)))
lLst); end mapcar
(if(member
(setq aName(vla-get-Name(vla-get-Activelayer actDoc)))
(mapcar 'vla-get-Name lLst))
(princ(strcat "\nCan't freeze active layer '" aName "'! "))
); end if
); end condition #6
((= "Thaw" Ans)
(StoreLayerStates)
(mapcar '(lambda(l)(if(not(member(vla-get-Name l)
(list
(vla-get-Name
(vla-get-ActiveLayer actDoc))
"0")))
(vla-put-Freeze l :vlax-false)))
lLst); end mapcar
(setvar "CMDECHO" 0)
(command "_.regenall")
(setvar "CMDECHO" 1)
); end condition #6
((= "Isolate" Ans)
(StoreLayerStates)
(vlax-for l(vla-get-Layers actDoc)
(if(not(wcmatch(strcase(vla-get-Name l))(strcase laypat:pat)))
(vla-put-LayerON l :vlax-false)
); end if
); end vlax-for
); end condition #7
((= "Previouos" Ans)
(if patlay:layerstate
(progn
(setq oldLay(vla-get-ActiveLayer actDoc))
(setvar "CLAYER" "0")
(mapcar '(lambda(l)
(vla-put-LayerOn(car l)(cadr l))
(vla-put-Lock(car l)(nth 2 l))
(if(not(member(vla-get-Name(car l))
(list
(vla-get-Name
(vla-get-ActiveLayer actDoc))
"0")))
(vla-put-Freeze(car l)(last l))))
patlay:layerstate); end mapcar
(if
(and
(/= :vlax-true(vla-get-Freeze oldLay))
(not(vl-catch-all-error-p
(vl-catch-all-apply 'vla-get-Name
(list oldLay))))
); end and
(vla-put-ActiveLayer actDoc oldLay)
); end if
(StoreLayerStates)
); end progn
(princ "\nPreviouos layer state missed ")
); end if
); end condition #8
((= "Highlight" Ans)
(sssetfirst nil(ssget "_X"(list(cons 8 laypat:pat))))
); end condition #9
((or(not Ans)(= "Quit" Ans))
(princ "\nQuit LAYPAT ")
); end condition #10
); end cond
(vla-EndUndoMark actDoc)
); end while
); end progn
(princ "\nNo layers found! ")
); end if
); end progn
(setq laypat:pat oldPat)
); end if
(princ)
); end of c:patlay
(princ "\n*** Type PATLAY for wildcard layer actions*** ")
页:
[1]