手机站
网通分站
电信主站
密 码:
用户名:
当前位置 : 主页>网络编程>Asp.Net编程>列表

应用Automation技术进行AutoCad的开发

来源:互联网 作者:西部数码 时间:2008-04-09
西部数码-全国虚拟主机10强!40余项虚拟主机管理功能,全国领先!双线多线虚拟主机南北访问畅通无阻!免费赠送企业邮局,.CN域名,自助建站480元起,免费试用7天,满意再付款! P4主机租用799元/月.月付免压金!


   Set acaddoc=Application.ActiveDocument

  请看下面的例子对文件的操作:

Dim dwgname As String
dwgname = "c:\acadr14\sample\campus.dwg"
If Dir(dwgname) <> "" Then
  acaddoc.Open dwgname   '打开一个CAD文件
Else
  acaddoc.new("acad")  '以acad.dwt为模板建立一个新
             文件
End If
Document对象还提供了两个十分有用的方法——SetVariable 和 GetVariable,通过它们可以得到或改变AutoCad的系统变量。
如:acaddoc.SetVariable "Orthomode", 1 '打开正交模式
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自动实现变换视图角度及缩放全图。

文章整理:西部数码--专业提供域名注册虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息,谢谢!