在paperspace中自动添加尺寸。

Public Sub ModeltoPaperSpacePoint()
    Dim vp As AcadPViewport, Ent As AcadEntity, VarPick
    Dim util As AcadUtility, M1, P1
    Dim i As Integer, dblScale As Double
    Dim VpCol As New Collection
    Dim PSpt As AcadPoint, MSpt As AcadPoint
    
    Set util = ThisDrawing.Utility
    If ThisDrawing.ActiveSpace = acModelSpace Then
        MsgBox "Command not allowed unless TILEMODE is set to 0"
        Exit Sub
    End If
    For Each Ent In ThisDrawing.PaperSpace
        If TypeOf Ent Is AcadPViewport Then
            i = i + 1
            VpCol.Add Ent
        End If
    Next
    If i = 1 Then
        MsgBox "Please add a viewport"
        Exit Sub
    End If
     'Debug.Print i
    If ThisDrawing.MSpace = False Then
        If i > 2 Then
            util.GetEntity Ent, VarPick, "Pick a viewport:"
            If TypeOf Ent Is AcadPViewport Then
                Set vp = Ent
            Else
                Exit Sub
            End If
         Else
            Set vp = VpCol(2)
        End If
        vp.Display True
        ThisDrawing.MSpace = True
        ThisDrawing.ActivePViewport = vp
    Else
        Set vp = ThisDrawing.ActivePViewport
    End If
    vp.DisplayLocked = True
 
    M1 = util.GetPoint(, "Pick a point:")
    Set MSpt = ThisDrawing.ModelSpace.AddPoint(M1)
    MSpt.Color = acBlue
   P1 = util.TranslateCoordinates(M1, acWorld, acDisplayDCS, False)
   P1 = util.TranslateCoordinates(P1, acDisplayDCS, acPaperSpaceDCS, False)
    ThisDrawing.MSpace = False
    Set PSpt = ThisDrawing.PaperSpace.AddPoint(P1)
    PSpt.Color = acGreen
    Set vp = Nothing
    
End Sub
Public Sub PapertoModelSpacePoint()
    Dim Ent As AcadEntity, VarPick
    Dim util As AcadUtility, M1, P1
    Dim PSpt As AcadPoint, MSpt As AcadPoint
    Set util = ThisDrawing.Utility
    ThisDrawing.ActiveSpace = acPaperSpace
    ThisDrawing.MSpace = False
    P1 = util.GetPoint(, "Pick a point:")
    Set PSpt = ThisDrawing.PaperSpace.AddPoint(P1)
    PSpt.Color = acGreen
    P1 = util.TranslateCoordinates(P1, acPaperSpaceDCS, acDisplayDCS, False)
    M1 = util.TranslateCoordinates(P1, acDisplayDCS, acWorld, False)
   
    Set MSpt = ThisDrawing.ModelSpace.AddPoint(M1)
    MSpt.Color = acBlue
    
End Sub

Public Sub PapertoModelSpacePoint()
    Dim Pv As AcadPViewport, Ent As AcadEntity, VarPick
    Dim util As AcadUtility
    Dim PSpt As AcadPoint, MSpt As AcadPoint
    Dim M1, P1, Orig
    Set util = ThisDrawing.Utility
    ThisDrawing.ActiveSpace = acPaperSpace
    ThisDrawing.MSpace = False
    P1 = util.GetPoint(, "Pick a point:")
    Set PSpt = ThisDrawing.PaperSpace.AddPoint(P1)
    PSpt.Color = acGreen
    Set Pv = EntSel
    ThisDrawing.MSpace = True
    ThisDrawing.ActivePViewport = Pv
    P1 = util.TranslateCoordinates(P1, acPaperSpaceDCS, acDisplayDCS, False)
    M1 = util.TranslateCoordinates(P1, acDisplayDCS, acWorld, False)
    Set MSpt = ThisDrawing.ModelSpace.AddPoint(M1)
    MSpt.Color = acBlue
    ThisDrawing.ActiveSpace = acPaperSpace
    
End Sub