自定义菜单栏

rajuks · 发表于 2022-7-6 17:15:52

大家好

我不熟悉autocad。过去4年，我一直在为Microstation编程/定制。但我的新工作需要autocad自定义。我有一个小问题。我想制作一个自定义菜单栏，这样当操作员从该菜单中选择任何命令时，当前层名称应自动更改并激活所需的命令。
例如，操作员想要绘制一条中心线，然后他将从我的菜单中选择“cntrLine”命令，然后活动层应更改为“中心线”层（已经存在），同时line命令应激活。

这类似于Microstation中的边栏菜单（sbm文件）。

有人能帮我做这个话题吗。
收获与感谢
萨提亚

NBC · 发表于 2022-7-6 17:28:26

这将更容易在工具选项板中实现。

GhostRider · 发表于 2022-7-6 17:36:44

是的，我认为你可以用几种不同的方式来实现，每个按钮都有一个小的lisp，或者作为一个包含所有命令的lisp，由每个按钮调用，或者将每个命令lisp添加到acad中。lsp，在工具托盘中，我在工具栏和托盘中都使用它们，我不是专家，但我使用这样的小Lisp。

copy

^C^C(cont) ^P(PROGN (command "layer" "t" "[color=red]centerline[/color]" "s" "[color=#ff0000]centerline[/color]" "f" "*" "t" "0,defpoints" "")(command "line")(princ))

并添加其他命令

StevJ · 发表于 2022-7-6 17:41:20

我在工作的地方做类似的设置。

下面的宏为我实现了这一点。

copy

^C^C-LAYER;SET;CenterLine;ON;;;_line

rajuks · 发表于 2022-7-6 17:49:29

谢谢大家的建议。我对自动Lisp程序一无所知。我擅长VBA。我会努力研究你的建议。
非常感谢你
萨提亚

rocheey · 发表于 2022-7-6 17:56:24

这里有一个又快又脏的，其中一半是从帮助文件中偷来的。
它动态创建工具栏，并将VBA子例程附加到它添加的每个按钮。希望它能让你开始。

copy


Sub ToolbarButton()
   
   Dim currMenuGroup As AcadMenuGroup
   Set currMenuGroup = ThisDrawing.Application.MenuGroups.Item(0)
   
   ' Create the new toolbar
   Dim newToolBar As AcadToolbar
   Set newToolBar = currMenuGroup.Toolbars.Add("TestToolbar5")
   
   ' Add a button to the new toolbar
   Dim newButton1 As AcadToolbarItem, newButton2 As AcadToolbarItem
   Dim openMacro1 As String, openMacro2 As String
   
   ' Assign the macro string the VB equivalent of "ESC ESC _open "
    openMacro1 = "-VBARUN " & "SampleSub1" & " " ' add a space to enmnu item to emulate the ENTER key]'
    Set newButton1 = newToolBar.AddToolbarButton("", "NewButton1", "Sample Macro 1", openMacro1)
    
    ' Assign the macro string the VB equivalent of "ESC ESC _open "
    openMacro2 = "-VBARUN " & "SampleSub2" & " " ' add a space to enmnu item to emulate the ENTER key]'
    Set newButton2 = newToolBar.AddToolbarButton("", "NewButton2", "Sample Macro 2", openMacro2)
   
   ' Display the toolbar
   newToolBar.Visible = True
   
End Sub
Sub SampleSub1()
   Dim tmpLayer As AcadLayer
   Set tmpLayer = ThisDrawing.Layers.Item("0")
   ThisDrawing.ActiveLayer = tmpLayer
   ThisDrawing.SendCommand "Line "
End Sub
Sub SampleSub2()
   Dim tmpLayer As AcadLayer
   Set tmpLayer = ThisDrawing.Layers.Item("0")
   ThisDrawing.ActiveLayer = tmpLayer
   ThisDrawing.SendCommand "Circle "
End Sub