哪位大侠能帮我看一下，程序问题出在何处？

luo_yongquan

程序思路：根据图框的四个角点范围区定比例打印图幅。
Public Sub 图纸批打印()   '取图框四个角点坐标

    Call SelectionSets.CreatSelectionSets_图框
Dim SSetColl As AcadSelectionSets
    Set SSetColl = ThisDrawing.SelectionSets
Dim ssetObj_tq, Ssetobj_ptx, Ssetobj_data, Ssetobj_ptfwx As AcadSelectionSet
    Set ssetObj_tq = SSetColl.Item("图框")
Dim SsetCount, I  As Integer
Dim blkRefobj As AcadBlockReference
Dim InsPnt
Dim PntA(0 To 1) As Double
Dim PntB(0 To 1) As Double
Dim AngelRot, BlockScaleX, BlockScaleY, Dist As Double
    SsetCount = ssetObj_tq.Count
    For I = 0 To SsetCount - 1
      Set blkRefobj = ssetObj_tq(I)
      InsPnt = blkRefobj.InsertionPoint
      AngelRot = blkRefobj.Rotation
      BlockScaleX = blkRefobj.XScaleFactor
      BlockScaleY = blkRefobj.YScaleFactor
      If StrComp(UCase(blkRefobj.Name), "TK48A", 1) = 0 Then
         PntA(0) = InsPnt(0)
         PntA(1) = InsPnt(1)
         PntB(0) = PntA(0) + 865 * BlockScaleX * Cos(AngelRot) + 392 * BlockScaleX * Cos(AngelRot + 3.1415926 / 2)
         PntB(1) = PntA(1) + 865 * BlockScaleY * Sin(AngelRot) + 392 * BlockScaleY * Sin(AngelRot + 3.1415926 / 2)
         PntA(0) = PntA(0) + 1 * BlockScaleX * Cos(AngelRot + 204.3791667 * 3.1415926 / 180)
         PntA(1) = PntA(1) + 1 * BlockScaleY * Sin(AngelRot + 204.3791667 * 3.1415926 / 180)
         PntB(0) = PntB(0) + 1 * BlockScaleX * Cos(AngelRot + 24.3791667 * 3.1415926 / 180)
         PntB(1) = PntB(1) + 1 * BlockScaleY * Sin(AngelRot + 24.3791667 * 3.1415926 / 180)
      Else
         PntA(0) = InsPnt(0)
         PntA(1) = InsPnt(1)
         PntB(0) = PntA(0) + 820 * BlockScaleX * Cos(AngelRot) + 578 * BlockScaleX * Cos(AngelRot + 3.1415926 / 2)
         PntB(1) = PntA(1) + 820 * BlockScaleY * Sin(AngelRot) + 578 * BlockScaleY * Sin(AngelRot + 3.1415926 / 2)
         PntA(0) = PntA(0) + 1 * BlockScaleX * Cos(AngelRot + 215.1791667 * 3.1415926 / 180)
         PntA(1) = PntA(1) + 1 * BlockScaleY * Sin(AngelRot + 215.1791667 * 3.1415926 / 180)
         PntB(0) = PntB(0) + 1 * BlockScaleX * Cos(AngelRot + 35.1791667 * 3.1415926 / 180)
         PntB(1) = PntB(1) + 1 * BlockScaleY * Sin(AngelRot + 35.1791667 * 3.1415926 / 180)
      End If
Dim lineobj1 As AcadLine
Dim f(0 To 2) As Double
Dim s(0 To 2) As Double
f(0) = PntA(0): f(1) = PntA(1): f(2) = 0
s(0) = PntB(0): s(1) = PntB(1): s(2) = 0
Set lineobj1 = ThisDrawing.ModelSpace.AddLine(f, s)
ThisDrawing.SendCommand "_Dview" & vbCr & vbCr & "TW" & vbCr & -AngelRot * 180 / 3.1415926 & vbCr & vbCr
ThisDrawing.Regen acActiveViewport
      Select Case BlockScaleX
         Case 0.5
           ThisDrawing.Layouts("Model").SetCustomScale 2, 1
         Case 1
           ThisDrawing.Layouts("Model").SetCustomScale 1, 1
         Case 2
           ThisDrawing.Layouts("Model").SetCustomScale 1, 2
      End Select
   ThisDrawing.Layouts("Model").PlotRotation = ac0degrees
    Dim width As Double
    Dim height As Double
    ThisDrawing.Layouts("Model").GetPaperSize width, height
    If width < 875 Then
       MsgBox "图纸宽度设置不对，查看绘图仪设置"
       Exit Sub
    End If
    Dim originalValue As Variant
    Dim newValue(0 To 1) As Double
    originalValue = ThisDrawing.Layouts("Model").PlotOrigin
    newValue(0) = 0
    newValue(1) = 0
    ThisDrawing.Layouts("Model").PlotOrigin = newValue
    ThisDrawing.ActiveLayout.SetWindowToPlot PntA, PntB
    ThisDrawing.ActiveLayout.PlotType = acWindow
    ThisDrawing.Plot.DisplayPlotPreview acFullPreview
    'ThisDrawing.Plot.PlotToDevice '"D:\Program Files\AutoCAD 2002\Plotters\HP DesignJet 500 42_HPGL2 Card.pc3"
    Next I
   
    MsgBox "打印完毕，共有" & SsetCount & "幅"





Public Sub CreatSelectionSets_图框()
    Dim SSetColl As AcadSelectionSets
    Set SSetColl = ThisDrawing.SelectionSets
   
    Dim Ssetobj As AcadSelectionSet
    Dim I As Integer
   
    If SSetColl.Count <> 0 Then
      For I = 0 To SSetColl.Count - 1
        Set Ssetobj = SSetColl.Item(I)
        If StrComp(Ssetobj.Name, "图框", 1) = 0 Then
           Ssetobj.Delete
           Exit For
        End If
      Next
    End If
   Set Ssetobj = SSetColl.Add("图框")
   
   Dim FilterType, FilterData As Variant
   Dim gpCode(0) As Integer
   Dim dataValue(0) As Variant
   Dim mode As Integer
    mode = acSelectionSetAll
    gpCode(0) = "2"
   
    dataValue(0) = "tk48a"
    FilterType = gpCode
    FilterData = dataValue
    Ssetobj.Select mode, , , FilterType, FilterData
    If Ssetobj.Count = 0 Then
      dataValue(0) = "tk68a"
      FilterData = dataValue
      Ssetobj.Select mode, , , FilterType, FilterData
    End If
   ' MsgBox " 共有" & Ssetobj.Count & "个"
End Sub