边框问题

' 绘边框的VBA程序
Public Sub test()
Dim ss As AcadSelectionSet
Dim i As AcadEntity
Dim pEntity(0) As AcadEntity
Dim ssetObj As AcadSelectionSet
For Each ssetObj In ThisDrawing.SelectionSets
                         If ssetObj.Name = "SS" Then
                                                         ssetObj.Clear
                                                         ssetObj.Delete
                                                         Exit For
                         End If
Next ssetObj
Set ssetObj = ThisDrawing.SelectionSets.Add("SS")
Set ss = ThisDrawing.ActiveSelectionSet
ss.Select acSelectionSetAll
ss(0).GetBoundingBox pmin, pmax
For Each i In ss
i.GetBoundingBox p1, p2
If p1(0)  pmax(0) Then pmax(0) = p2(0)
If p2(1) > pmax(1) Then pmax(1) = p2(1)
Next i
ThisDrawing.SendCommand "_.RECTANG " & pmin(0) & "," & pmin(1) & vbCr & pmax(0) & "," & pmax(1) & vbCr
Set pEntity(0) = ThisDrawing.ModelSpace(ThisDrawing.ModelSpace.Count - 1)Dim offsetObj As Variant
offsetObj = pEntity(0).Offset(500)
pEntity(0).Delete
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
pmax(0) = pmax(0) + 500
pmin(1) = pmin(1) - 500
Dim ucsobj As AcadUCS
Dim origin As Variant
Dim xAxispnt As Variant
Dim yAxispnt As Variant
Dim utilObj As Object
Set utilObj = ThisDrawing.Utility
'定义ucs
utilObj.CreateTypedArray origin, vbDouble, pmax(0), pmin(1), 3
utilObj.CreateTypedArray xAxispnt, vbDouble, pmax(0) + 1, pmin(1), 3
utilObj.CreateTypedArray yAxispnt, vbDouble, pmax(0), pmin(1) + 1, 3
Set ucsobj = ThisDrawing.UserCoordinateSystems.Add(origin, xAxispnt, yAxispnt, "new_ucs")
ThisDrawing.ActiveViewport.UCSIconAtOrigin = True
        ThisDrawing.ActiveViewport.UCSIconOn = True
         ThisDrawing.ActiveUCS = ucsobj
Set pEntity(0) = ThisDrawing.ModelSpace(ThisDrawing.ModelSpace.Count - 1)
Dim offsetObj1 As Variant
offsetObj1 = pEntity(0).Offset(50)
''''定义块的插入点
Dim blockInspoint(0 To 2) As Double
Dim blockRefobj As AcadBlockReference
blockInspoint(0) = pmax(0)
blockInspoint(1) = pmin(1)
blockInspoint(2) = 3
Set blockRefobj = ThisDrawing.ModelSpace.InsertBlock(inspoint, "F:\我的课题\陶瓷工业梭式窑CAD系统1\窑车标注1.dwg", 1, 1, 1, 0)