[CP原创]VBA/VLISP函数：双解对照设置当前层

CamPtt

[CP原创]VBA/VLISP函数：设置当前层双解对照

2. 
   
3. 
   
4. '
   
5. '设置当前层,如果指定名称的层不存在则新建
   
6. '
   
7. Public Function myvb_LayerSet(LayerName As String)
   
8. 
   
9.     Dim objLayer As AcadLayer
   
10.     Dim FindLayer As Boolean
    
11.    
    
12.     FindLayer = False
    
13.     For Each objLayer In ThisDrawing.Layers
    
14.         If UCase(objLayer.Name) = UCase(LayerName) Then
    
15.             FindLayer = True
    
16.             Exit For
    
17.         End If
    
18.     Next
    
19.    
    
20.     If FindLayer = True Then '已存在
    
21.         Set objLayer = ThisDrawing.Layers(LayerName)
    
22.         If objLayer.Freeze = True Then '解冻
    
23.             objLayer.Freeze = False
    
24.         End If
    
25.         objLayer.Lock = False '解锁
    
26.         objLayer.LayerOn = True '可见
    
27.     Else '不存在时新建
    
28.         Set objLayer = ThisDrawing.Layers.Add(LayerName)
    
29.     End If
    
30.     ThisDrawing.ActiveLayer = objLayer '设为当前层
    
31. 
    
32. End Function
    
33. 
    
34. 
    
35. ;;;======================================================================;
    
36. ;;;设置当前层,如果指定名称的层不存在则新建                               ;
    
37. ;;;======================================================================;
    
38. (defun myvl_LayerSet (layName / acDoc lays lay)
    
39.   (setq        acDoc (vla-get-ActiveDocument (vlax-get-acad-object))
    
40.         lays  (vla-get-Layers acDoc)
    
41.   )
    
42.   (if (= (tblsearch "layer" layName) nil)
    
43.     (progn                                ;不存在
    
44.       (setq lay (vla-Add lays layName))        ;新建
    
45.       (vla-put-ActiveLayer acDoc lay)        ;设为当前层
    
46.     )
    
47.     (progn                                ;已存在
    
48.       (setq lay (vla-Item lays layName))
    
49.       (if (= (vla-get-Freeze lay) :vlax-true)
    
50.         (vla-put-Freeze lay :vlax-false) ;解冻
    
51.       )
    
52.       (if (= (vla-get-Lock lay) :vlax-true)
    
53.         (vla-put-Lock lay :vlax-false)        ;解锁
    
54.       )
    
55.       (if (= (vla-get-LayerOn lay) :vlax-false)
    
56.         (vla-put-LayerOn lay :vlax-true) ;可见
    
57.       )
    
58.       (vla-put-ActiveLayer acDoc lay)        ;设为当前层
    
59.     )
    
60.   )
    
61. )
    

<br /> <br /> '<br /> '设置当前层,如果指定名称的层不存在则新建<br /> '<br /> Public Function myvb_LayerSet(LayerName As String)<br /> <br />     Dim objLayer As AcadLayer<br />     Dim FindLayer As Boolean<br />     <br />     FindLayer = False<br />     For Each objLayer In ThisDrawing.Layers<br />         If UCase(objLayer.Name) = UCase(LayerName) Then<br />             FindLayer = True<br />             Exit For<br />         End If<br />     Next<br />     <br />     If FindLayer = True Then '已存在<br />         Set objLayer = ThisDrawing.Layers(LayerName)<br />         If objLayer.Freeze = True Then '解冻<br />             objLayer.Freeze = False<br />         End If<br />         objLayer.Lock = False '解锁<br />         objLayer.LayerOn = True '可见<br />     Else '不存在时新建<br />         Set objLayer = ThisDrawing.Layers.Add(LayerName)<br />     End If<br />     ThisDrawing.ActiveLayer = objLayer '设为当前层<br /> <br /> End Function<br /> <br /> <br /> ;;;======================================================================;<br /> ;;;设置当前层,如果指定名称的层不存在则新建                               ;<br /> ;;;======================================================================;<br /> (defun myvl_LayerSet (layName / acDoc lays lay)<br />   (setq        acDoc (vla-get-ActiveDocument (vlax-get-acad-object))<br />         lays  (vla-get-Layers acDoc)<br />   )<br />   (if (= (tblsearch "layer" layName) nil)<br />     (progn                                ;不存在<br />       (setq lay (vla-Add lays layName))        ;新建<br />       (vla-put-ActiveLayer acDoc lay)        ;设为当前层<br />     )<br />     (progn                                ;已存在<br />       (setq lay (vla-Item lays layName))<br />       (if (= (vla-get-Freeze lay) :vlax-true)<br />         (vla-put-Freeze lay :vlax-false) ;解冻<br />       )<br />       (if (= (vla-get-Lock lay) :vlax-true)<br />         (vla-put-Lock lay :vlax-false)        ;解锁<br />       )<br />       (if (= (vla-get-LayerOn lay) :vlax-false)<br />         (vla-put-LayerOn lay :vlax-true) ;可见<br />       )<br />       (vla-put-ActiveLayer acDoc lay)        ;设为当前层<br />     )<br />   )<br /> )<br />