VB-VBA

pmq 发表于 2005-3-5 14:06:00

明总你好，我有几个问题请教先谢了

1、先选择后执行，VBA怎样实现； 我看了<A href="dispbbs.asp?boardID=4&ID=28516&page=1" target="_blank" >dispbbs.asp?boardID=4&ID=28516&page=1</A>　的帖子，还是搞不太董。 下面是我自编的一个"删除图层上的所有实体"的程序

Sub TC1() '删除实体所在图层 On Error Resume Next '删除图层中的对象 Dim objDest As AcadEntity Dim ptBase As Variant Dim FilterType As Variant Dim FilterData As Variant Dim Sel As AcadSelectionSet Dim fdata(0) As Variant Dim ftype(0) As Integer Dim Pickedobj As AcadEntity Dim VByn As String Dim TCName As String Do 　　'如果先选择了一个实体,这里应该怎样添加判断选择集不为空,就不用执行下面一行的程序。　 ThisDrawing.Utility.GetEntity objDest, ptBase, "选择所删除图层中的实体>>" If objDest.ObjectName = "" Then VByn = MsgBox("请重新选择图层", 5, "删除图层") If VByn <> "4" Then Exit Sub End If Else Exit Do End If Loop ftype(0) = 8 fdata(0) = objDest.Layer FilterType = ftype FilterData = fdata TCName = objDest.Layer If ThisDrawing.Layers(TCName).Lock = True Then VByn = MsgBox("该图层已锁定,删除", 4, "删除图层") If VByn = "6" Then ThisDrawing.Layers(TCName).Lock = False '解锁 Else Exit Sub End If End If Set Sel = ThisDrawing.SelectionSets.Add("ssel") If Err Then Err.Clear ThisDrawing.SelectionSets("ssel").Delete Set Sel = ThisDrawing.SelectionSets.Add("ssel") End If Sel.Select acSelectionSetAll, , , FilterType, FilterData For Each Pickedobj In Sel Pickedobj.Delete Next End Sub 如果先选择了一个实体,应该怎样加载运行这个宏？

2、按右键怎么运行上次执行的宏； 如果执行完上面的命令后，按右键怎么运行上次运行的程序，不要老是提示输入宏名称。

3、VB自编菜单命令怎样加载运行自己写的宏，老是说执行宏错误，宏应放在什么地方。 '新菜单2 Dim MenuOpenB As AcadPopupMenuItem Dim newMenuB As AcadPopupMenu Set newMenuB = currMenuGroup.Menus.Add("图层管理") Set MenuOpenB = newMenuB.AddMenuItem(newMenuB.Count + 1, "删除图层上的所有实体", "-vbarun TC1" & vbCr) Set MenuOpenB = newMenuB.AddMenuItem(newMenuB.Count + 1, "打开所有图层", "-vbarun TC2" & vbCr) newMenuB.InsertInMenuBar (6) '在菜单条上第6个位置显示菜单

Sub TC2() '打开所有图层 Dim objLayer As AcadLayer For Each objLayer In acadapp.Layers objLayer.LayerOn = True Next End Sub

4、用比例缩放对象ScaleEntity方法缩放实体，是在X、Y、H三个方向上等比例缩放，我只要在X、Y平面上比例缩放，H高程不变，怎样实现？

页: [1]

明经CAD社区's Archiver

VB-VBA