大至就是类似下面这段程序,只要这里能画图的话,其它应该都是这种情况了。拜托了!!![br]Public acadobj As Object 'ThisDrawing
Public acaddoc As AcadDocument
Public mospace As AcadModelSpace
Public mypaperspace As AcadPaperSpace
Public myucs As AcadUCS
Public utilObj As AcadUtility
Public layerObj As AcadLayer
Private Sub Command1_Click()
Dim textacad As AcadText
Dim fileName As String
On Error Resume Next
Set acadobj = GetObject(, "AutoCAD.Application")
If Err Then
Err.Clear
Set acadobj = CreateObject("AutoCAD.Application")
If Err Then
MsgBox Err.Description
Exit Sub
End If
End If
acadobj.Visible = True
fileName = "C:\×÷ÒµCHEN\GBS-H2-10-05X42±¸·Ý.dwg"
If Dir(fileName) <> "" Then
Set acaddoc = acadobj.ActivDocument.Open(fileName)
Else
MsgBox "File " & fileName & " does not exist."
End If
Set mypaperspace = acaddoc.PaperSpace
Set mospace = acaddoc.ModelSpace
Set myucs = acaddoc.ActiveUCS
Set utilObj = acaddoc.Utility
Set layerObj = acaddoc.Layers.Add("LAYER1")
layerObj.Color = acMagenta
End Sub
Private Sub Command2_Click()
Dim lineObj As AcadLine
Dim startPoint(0 To 2) As Double
Dim EndPoint(0 To 2) As Double
Dim i As Integer
startPoint(0) = 10#
startPoint(1) = 10#
startPoint(2) = 0#
EndPoint(0) = 100#
EndPoint(1) = 100#
EndPoint(2) = 0#
For i = 0 To 2
Debug.Print startPoint(i) & "***" & EndPoint(i)
Next i
Set lineObj = acaddoc.ModelSpace.AddLine(startPoint, EndPoint)
With lineObj
.Color = acRed
.Visible = True
.Update
End With
acaddoc.ActivePViewport.ZoomAll
acadobj.ZoomAll
acaddoc.Save
End Sub
Private Sub Command5_Click()
Set acaddoc = Nothing
acadobj.Quit
Set acadobj = Nothing
End