明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1454|回复: 0

VB-VBA

[复制链接]
发表于 2005-3-5 14:06:00 | 显示全部楼层 |阅读模式
明总你好,我有几个问题请教 先谢了 1、先选择后执行,VBA怎样实现;
我看了dispbbs.asp?boardID=4&ID=28516&page=1 的帖子,还是搞不太董。
下面是我自编的一个"删除图层上的所有实体"的程序 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高程不变,怎样实现?
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-27 18:50 , Processed in 0.232720 second(s), 22 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表