社区 › Auto Lisp › 自定义菜单栏

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。
 
^C^C(cont) ^P(PROGN (command "layer" "t" "centerline" "s" "centerline" "f" "*" "t" "0,defpoints" "")(command "line")(princ))
 
并添加其他命令

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

我在工作的地方做类似的设置。
 
下面的宏为我实现了这一点。
 
^C^C-LAYER;SET;CenterLine;ON;;;_line

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

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

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

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



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

NOELCAD 发表于 2022-7-6 18:03:27

我正在acad中寻找创建lisp或运行lisp。。2008
找不到选项。。
有人能帮我一下吗。。

dumfatnhappy 发表于 2022-7-6 18:10:14

 
欢迎rajuks，让另一个灵魂从“黑暗面”走出来
祝贺

Irish 发表于 2022-7-6 18:19:23

是的，到模型空间。

查看完整版本: 自定义菜单栏