KYLO 发表于 2024-5-14 21:10:26

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]
查看完整版本: VBA代码隐藏不需要的图层