|
发表于 2009-6-28 07:23:00
|
显示全部楼层
Option Explicit
Dim D As New AxDbDocument
Dim blockRefObjs(0) As AcadBlockReference
Sub newdoc()
Dim insertionPnt(2) As Double
insertionPnt(0) = 33: insertionPnt(1) = 138: insertionPnt(2) = 0
On Error Resume Next
Set blockRefObjs(0) = D.ModelSpace.InsertBlock(insertionPnt, "d:\指北针.dwg", 1#, 1#, 1#, 0)
test ("0")
test ("1")
test ("2")
End Sub
Private Sub test(name As String)
Dim newdoc As New AcadDocument
D.CopyObjects blockRefObjs, newdoc.ModelSpace
newdoc.Close True, ThisDrawing.Path & "\" & name
End Sub |
|