4．与用户交互

　　Utility对象提供了与用户在命令行交互的途径，可以让用户输入数字、字符串及角度、点坐标等参量。下面说明如何应用Utility交互替代AutoCad命令中的提示：

Dim acadUtil as Object Dim stPnt, enPnt As Variant　　　　 Dim prompt1, prompt2 As String　　 Set acadUtil=acaddoc.Utility　　 '设置Utility对象 prompt1 = "起始点： "　‘代替From Point prompt2 = "终止点： "　 '代替End Point stPnt = acadUtil.GetPoint(, prompt1) enPnt = acadUtil.GetPoint(stPnt, prompt2)　 '获得用户输入（既可输入坐标值，也可直接在屏幕上选点） Dim startPoint(0 To 2) As Double　 Dim endPoint(0 To 2) As Double　　 startPoint(0) = stPnt(0)　　　　　　 startPoint(1) = stPnt(1)　　　　　　 startPoint(2) = stPnt(2)　　　　 endPoint(0) = enPnt(0)　　　　 endPoint(1) = enPnt(1)　　　　 endPoint(2) = enPnt(2)　　　 moSpace.AddLine startPoint, endPoint '利用用户输入生成直线 把系统变量设置SetVariable与Utility对象的GetString方法结合，即可向AutoCad的状态行写入内容： 　 Dim yourname as String 　　　　　yourname = acadUtil.GetString(0, " 请输入您的姓名： ") 　 acaddoc.SetVariable "MODEMACRO", yourname & ", 你好！"

　　 5.对非图形对象的操作

　　非图形对象如层（Layers）、视图（Viewports）、坐标系(UCSs)、块　(Blocks)等与图形实体集合ModelSpace、PaperSpace同是Document对象的子对象，它们本身既是对象，又是对象的集合，如Layers是当前打开的图中所有层的集合，使用Add方法来建立新层，并可以遍历所有层，通过改变其属性达到关闭（Off）、冻结层(Freeze)的目的.

　　①把层名为"wall"的层冻结，打开层名为"beam"的层,并设为当前层

Dim tlayer as Object 　For Each tlayer In acaddoc.Layers 　　　If tlayer.Name = "wall" Then 　　　　tlayer.Freeze = acTrue　 　　　Else If tlayer.Name="beam" Then 　　　　tlayer.LayerOn = acTrue　 　　　　Set acaddoc.ActiveLayer = tlayer　 　　　End If 　Next

　 ②创建名为"myview"的新视图

　　可以通过ActiveX自动实现变换视图角度及缩放全图。

Public Sub changeview(ByVal x, ByVal y, ByVal z) Dim newDirection(0 To 2) As Double Dim vport As Object acaddoc.ActiveSpace = acModelSpace ‘使ModelSpace成为活动 　　　　　　　　　　　　　　　　　　 空间 Set vport = acaddoc.Viewports.Add("newview") ‘建立新视图 newDirection(0) = x newDirection(1) = y newDirection(2) = z　‘视图的视角方向 vport.Direction = newDirection acaddoc.ActiveViewport = vport　‘把新视图激活 acaddoc.ActiveViewport.ZoomAll　‘全图显示 End Sub

　　以上例程是对Layers、Viewports对象的举例，其他非图形对象的引用与此类似。

　　6．对选择集的操作

　　在对AutoCad的编程中，选择集占有十分重要的地位，对编程者而言，并不清楚图中包含什么实体，只有通过用户的选择或通过过滤条件把所需的实体加入选择集，再对选择集中的实体进行操作。下面例程给出了两种筛选建立选择集的方法，把图中所有在层"wall"上的直线亮显。

　　①由用户在屏幕上选择实体

　

Dim tempset as Object 　Dim obj as Object 　Set tempset = acaddoc.SelectionSets.Add("newset") '建立新选择集 tempset.SelectOnScreen　　 ‘用户在屏幕上选择 　For Each obj In tempset　 ‘遍历选择集中的实体 　　 If obj.EntityName="AcDbLine"　And obj.Layer="wall" Then 　　　　obj.HighLight(True)　'亮显实体 　　 End IF 　Next

　　这种选择方式给用户较大的自由，但不能保证选择集内包含所有我们期望的实体，若要精确过滤出所需实体，应该给选择集加入条件。

　　②使用过滤器（Filter）筛选实体

Dim actualCode(3) As String Dim actualValue(3) As String Dim groupcode As Variant Dim groupValue As Variant Dim extminpt(2) As Double Dim extmaxpt(2) As Double Dim tsset As Object Dim tobj As Object actualCode(0) = -4 actualValue(0) = " actualCode(1) = 8　　　 　　'保证 Layer是"wall" actualValue(1) = "wall" actualCode(2) = 100 actualValue(2) = "AcDbLine"　'所选实体为直线 actualCode(3) = -4 actualValue(3) = "AND>" extminpt(0) = 0 extminpt(1) = 0 extminpt(2) = 0 extmaxpt(0) = 800 extmaxpt(1) = 400 extmaxpt(2) = 0　　 ‘设选择集涉及区域的左上点与右下点坐标 groupcode = actualCode groupValue = actualValue Set tsset = acaddoc.SelectionSets.Add("SS2") tsset.Select acSelectionSetAll, extminpt, extmaxpt, groupcode,_　 groupValue ‘加了过滤器的选择集　 For Each tobj In tsset 　 tobj.HighLight(True)　 'tobj一定满足既是直线，又在层"wall"上 Nexe

　　上述变量中groupcode是组码，groupValue是组码下的值。只要找出相应的组码及其下的值，配合条件（And Or Not等，组码为-4）的使用，便可以构造出任意的过滤器，迅速获取所需实体的集合。

　　7．SendKeys的妙用

　　AutoCad的ActiveX虽然强大，但不是所有问题都可以通过它解决。要在VB中使用AutoCad对象没有的方法，就须用到VB中的过程SendKeys。通过SendKeys把AutoCad的命令行如同批处理一样送到AutoCad中自动执行，在效果上与使用对象的方法是相同的。另外，还可以使用简单的AutoLisp语言增强AutoCad命令行的功能。下例是执行break命令而编写的过程。其中的(handent"***")是从Lisp语言中借来的，可以直接在命令行通过实体句柄（Handle）来确定实体。

SendKeys "{esc}", True 　SendKeys "{esc}", True　‘避免以前命令的干扰 　SendKeys "_break" & "{enter}", True　 　SendKeys "{(}" & "handent" & """" & wallhandle & """" & "{)}" & "{enter}", True ‘选择要断开的实体（wallhandle为其句柄） 　SendKeys Format(cood1(0)) & "," & Format(cood1(1)) & "{enter}", True 　SendKeys Format(cood2(0)) & "," & Format(cood2(1)) & "{enter}", True　‘cood1与cood2是实体上断开点的坐标

相关搜索：