|
|
发表于 2003-6-26 18:21:00
|
显示全部楼层
看看吧，应该可以
*.exe就是n你每次点击的程序
Dim acadapp As AcadApplication
Dim acaddoc As AcadDocument
Sub connectcad() '连接AUTOCAD
On Error Resume Next
'与autocad通信
Set acadapp = GetObject(, "AutoCAD.Application")
If Err Then
Err.Clear
Set acadapp = CreateObject("AutoCAD.Application")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
End Sub
Sub connectdoc() '连接文档
Set acaddoc = acadapp.ActiveDocument
End Sub
Sub iniz()
connectcad
connectdoc
End Sub
Private Sub Command1_Click()
iniz
Dim currmenugroup As AcadMenuGroup
Set currmenugroup = acadapp.MenuGroups.Item(0)
Dim newtoolbar As AcadToolbar
For i = 0 To acadapp.MenuGroups.Item(0).Toolbars.Count - 1 Step 1
If CStr(acadapp.MenuGroups.Item(0).Toolbars.Item(i).name) = "iroltoolbars" Then
Set newtoolbar = acadapp.MenuGroups.Item(0).Toolbars.Item(i)
GoTo havemytoolbar
End If
Next
Set newtoolbar = currmenugroup.Toolbars.Add("iroltoolbars")
havemytoolbar:
Dim dcmacro As String, addmacro As String, rozjmacro As String, gzmacro As String
dcmacro = Chr(3) + Chr(3) + "start c:/myapp/dc.exe" + Chr(13)
addmacro = Chr(3) + Chr(3) + "start c:/myapp/add.exe" + Chr(13)
rozjmacro = Chr(3) + Chr(3) + "start c:/myapp/rozj.exe" + Chr(13)
gzmacro = Chr(3) + Chr(3) + "c:/myapp/gz.exe" + Chr(13)
addbutton newtoolbar, "对齐", "dc", dcmacro
addbutton newtoolbar, "内插点", "add", addmacro
addbutton newtoolbar, "旋转注记", "rozj", rozjmacro
addbutton newtoolbar, "数据改正", "gz", gzmacro
acadapp.MenuGroups.Item(0).Save acMenuFileSource
Unload Me
End Sub
Function addbutton(toolbar As AcadToolbar, name As String, helpstring As String, buttonmacro As String)
Dim newbutton As AcadToolbarItem
Set newbutton = toolbar.AddToolbarButton("", name, helpstring, buttonmacro)
End Function |
|
置顶卡
