3.2 计算机绘图功能的开发
计算机自动绘图功能的开发,将减轻设计人员的工作强度,提高设计效率.本设计系统采用过程ConnectCAD()与AutoCAD实现连接,用AcadApp ActiveDocument. ModelSpace的AddLine,AddText,AddDimAligned属性分别实现绘制直线,添加文字和进行尺寸标注,使系统能够快速准确的绘制出天然河道水面线成果图.
其中,过程ConnectCAD用于连接AutoCAD,程序代码如下:
Public ACADAPP As AcadApplication '检查运行AUTOCAD
Public Sub 连接autocad()
On Error Resume Next
Set ACADAPP = GetObject(, "AUTOCAD.APPLICATION")
If Err Then Err.Clear
Set ACADAPP = CreateObject("AUTOCAD.APPLICATION")
If Err Then
MsgBox ("不能运行AUTOCAD,请检查是否安装了AUTOCAD")
Exit Sub
End If
End If
ACADAPP.Visible = True : ACADAPP.Documents.Add
End Sub
AddLine属性用于绘制直线,程序代码如下:
Public Sub DrawLine(X1 As Variant, Y1 As Variant, X2 As Variant, Y2 As Variant, Lcolor As Integer)
Dim Lineobj As AcadLine : Dim Pstart(0 To 2) As Double
Dim Pend(0 To 2) As Double
Pstart(0) = X1 : Pstart(1) = Y1 : Pend(0) = X2 : Pend(1) = Y2
Set Lineobj = ACADAPP.ActiveDocument.ModelSpace.AddLine(Pstart, Pend)
Lineobj.Color = Lcolor
ZoomExtents
End Sub
AddText属性用于文本编辑,程序代码如下:
Public Sub WriteFont(P_Iinsert As Variant, Text_String As String, Text_Roation As Single, SIZE As Variant) 'CAD中写字
Dim Styobj As AcadTextStyle
Dim Typeface As String:Dim Bold As Boolean
Dim Italic As Boolean : Dim CharSet As Long
Dim PitchandFamily As Long:Dim Textobj As AcadText
Dim Insertp(0 To 2) As Double:Dim Height As Double
Set Styobj = ACADAPP.ActiveDocument.TextStyles.Add("M_Font1")
Typeface = "宋体" : Italic = True : CharSet = 1
PitchandFamily = 1 Or 16
Styobj.SetFont Typeface, Bold, Italic, CharSet, PitchandFamily
ACADAPP.ActiveDocument.ActiveTextStyle = Styobj
Insertp(0) = P_Iinsert(0) : Insertp(1) = P_Iinsert(1) : Height = SIZE
Set Textobj = ACADAPP.ActiveDocument.ModelSpace.AddText(Text_String, Insertp, Height)
Textobj.Rotation = Text_Roation
Textobj.Update

上一页下一页