I think you may have to use boundingboxes to establish which viewport you are using.
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