应用ActiveX Automation技术进行AutoCad的开发(2…

2008-02-23 06:52:32来源:互联网 阅读 ()

新老客户大回馈,云服务器低至5折


dim cadver As String
cadver=acaddoc.Getvariable("Acadver")  '获取AutoCad的版本号

3.对图形实体的自动操作(生成、编辑、查询)
  图形实体指所有画在屏幕上的物体,如直线(Line)、圆(Circle)、弧(Arc)、多义线(PolyLine)、文字(Text)等,它们包含于ModelSpace和PaperSpace集合对象中,对实体的操作总要从这两个集合开始,向下查找相应实体的方法或属性。ModelSpace与PaperSpace的含义和AutoCad中类似,它们是所有图形实体的集合,要取得图中的某一实体,一般采用遍历或用实体句柄(Handle)查找的方法。用户可以操作AutoCad自动生成、编辑实体或查询实体参数。请看下例:
   ①生成一个轻量多义线(LightWeight PolyLine)
Dim lwpoly As Object
Dim ptarray(0 To 5) As Double '设坐标变量
ptarray(0) = 2  
ptarray(1) = 4
ptarray(2) = 4  
ptarray(3) = 2
ptarray(4) = 10 
ptarray(5) = 4   
Set lwpolyObj = moSpace.AddLightWeightPolyline(ptarray)
‘画多义线(以(2,4,4)(2,10,4)为端点)
②改变一个现有长方体的颜色(假设此实体句柄为"4C")
  Dim tobj As object
       Set tobj=acaddoc.HandletoObject("4C") '通过Handle来获取
                         实体
  tobj.Color=acRed   ‘变颜色为红色
       tobj.Update      ‘更新状态
③查询当前图形文件中所有实体的实体名、实体句柄、颜色、所在层、线形等参数
Dim ent As Object         
Dim msgStr, NL As String       
Dim I as Integer
NL = Chr(13) & Chr(10)  ‘回车与换行
I=1
For Each ent in mospace '采用迭代遍历模型空间中的实体
  msgStr = "第" & Format(I) & "个实体信息" & NL & NL
  msgStr = msgStr & "实体名: " & ent.EntityName & NL
  msgStr = msgStr & "所在层: " & ent.Layer & NL
  msgStr = msgStr & "颜色: " & Str(ent.Color) & NL
  msgStr = msgStr & "线形: " & ent.Linetype & NL
  msgStr = msgStr & "句柄: " & ent.Handle & NL
  MsgBox msgStr
  I=I 1
Next

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   ‘用户在屏幕上选择

标签:

版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有

上一篇:用VB5.0开发通信软件的技巧

下一篇:利用API播放声音文件