VB如何显示/隐藏CAD的标题、菜单、命令行

pmq

VB如何显示/隐藏CAD的标题、菜单、工具栏、命令行、状态栏，前三样已经实现。

 

Private Sub AutoCADAll_Click(Index As Integer) 'CAD纳入到VB框中
    On Error Resume Next
    Set AcadApp = GetObject(, "AutoCAD.Application")   '启动AutoCad

    If Err Then
        Err.Clear
        Set AcadApp = CreateObject("AutoCAD.Application")
        If Err Then Exit Sub
    End If
    On Error GoTo 0
    lHwnd = GetParent(GetParent(AcadApp.ActiveDocument.hwnd))
   
    If lHwnd = 0 Then Exit Sub
    AcadApp.Visible = False
    AcadApp.WindowState = 2
    lState = AcadApp.WindowState
    GetWindowRect lHwnd, rS
    SetParent lHwnd, Frame.hwnd
    Me.ScaleMode = vbPixels
   
    '=================================================
    L = GetWindowLong(lHwnd, GWL_STYLE)    '隐藏标题
    L = L And Not (WS_CAPTION)
    L = SetWindowLong(lHwnd, GWL_STYLE, L) '隐藏标题
    '-------------------------------------------------
    Call HIdeMenus_Click '隐藏菜单
    Call HideTool_Click  '隐藏CAD工具栏
    '-------------------------------------------------
    Call Form_Resize
    AcadApp.Visible = True                 '使AutoCad可见
    Set AcadDoc = AcadApp.ActiveDocument   '设acaddoc为当前图形文件
    Set Mospace = AcadDoc.ModelSpace       '设mospace为当前图形文件的模型空间
    Set MyLayer = AcadDoc.Layers
End Sub

Private Sub HideTool_Click()  '隐藏/显示CAD工具栏
    On Error Resume Next
    Dim Menugroup As Object
    Dim Toolbar As Object
    Dim i As Integer
    Static CadTools() As Boolean
    i = 0
    If Hidetool.Checked = False Then
        For Each Menugroup In AcadApp.MenuGroups
            ReDim CadTools(1 To Menugroup.Toolbars.Count)
            For Each Toolbar In Menugroup.Toolbars
                i = i + 1
                CadTools(i) = Toolbar.Visible '添加工具栏状态
                Toolbar.Visible = False
            Next Toolbar
        Next Menugroup
        Hidetool.Checked = True
    Else
        For Each Menugroup In AcadApp.MenuGroups
            For Each Toolbar In Menugroup.Toolbars
                i = i + 1
                Toolbar.Visible = CadTools(i)
            Next Toolbar
        Next Menugroup
        Hidetool.Checked = False
    End If
    'ForceForegroundWindow AcadApp.hwnd ' 将焦点切换到AutoCAD
End Sub

Private Sub HIdeMenus_Click() '隐藏/显示CAD菜单
    On Error Resume Next
    If hMenu <> 0 Then Exit Sub
   
    If HIdeMenus.Checked = False Then
        cMenu = GetMenu(lHwnd)
        SetMenu lHwnd, 0
        HIdeMenus.Checked = True
    Else
        SetMenu lHwnd, cMenu
        HIdeMenus.Checked = False
    End If
End Sub
   

jsxygshh

本人调试了一个晚上也没有成功，水平太浅了，请不吝赐教给原实例好吗？    jsxygshh@163.com
十分感谢

jsxygshh

请pmq给个实例，谢谢

CAD83

请pmq给个实例，给看看