VBA代码隐藏不需要的图层
以下是用在中望CAD的VBA代码,用于实现隐藏不需要的图层,程序能正常运行,但是无法隐藏指定的图层,求大神指点Option Explicit
Sub XXX()
Application.ScreenUpdating = False '
Dim password As Variant
password = ThisWorkbook.Sheets("INPUT").Range("P2")
If password = "369" Then
Dim ZcadApp As ZcadApplication
Dim ZcadDoc As ZcadDocument
With ThisWorkbook.Sheets("Input")
If .Range("S8") <> "调试" Then
Dim wjmc As String
If .Range("S7") = "当前文件夹" Then
wjmc = ThisWorkbook.Path & "\" & .Range("S4") & ".dwg"
Else
wjmc = .Range("S7") & "\" & .Range("S4") & ".dwg"
End If
FileCopy .Range("S6") & "\" & .Range("S5") & ".dwg", wjmc
End If
On Error Resume Next '判断语句是否出错
Set ZcadApp = GetObject(, "ZWcad.application")
If Err Then
Err.Clear
Set ZcadApp = CreateObject("ZWcad.application")
If Err Then
MsgBox Err.Description'报错
Exit Sub
End If
End If
ZcadApp.Visible = True '
ZcadApp.WindowState = zcMax
If .Range("S8") <> "调试" Then
ZcadApp.Documents.Open wjmc
Else
ZcadApp.Documents.Open .Range("S6") & "\" & .Range("S5") & ".dwg"
End If
Set ZcadDoc = ZcadApp.ActiveDocument
Dim mxzdyd As String, mxzded As String, mcd As String, ncd As String
Dim i As Integer, n As Integer, mbgzb As String
Dim m As Integer
mbgzb = .Range("S5")
End With
With ThisWorkbook.Sheets(mbgzb)
Dim dz1 As ZcadLayer '隐藏图层
n = .Range("AC65536").End(xlUp).Row
For i = 3 To n
Set dz1 = ZcadDoc.Layers(.Range("AC" & i))
dz1.LayerOn = .Range("AD" & i)
End With
Set ZcadApp = Nothing
Set ZcadDoc = Nothing
End If
Application.ScreenUpdating = True
End Sub
页:
[1]