Imports Autodesk.AutoCAD.Interop
Imports Autodesk.AutoCAD.Interop.Common
Imports Autodesk.AutoCAD.Runtime
Imports System.Windows.Forms
<Assembly: CommandClass(GetType(Command))> 

Public Class Command

    'ここにコマンドの定義を追加します。

    'Sample Command...

    <CommandMethod("an_PPan", CommandFlags.Modal)> _
     Public Sub an_PspacePan()
        Dim acApp As AcadApplication = Loader.AcadApp
        Dim doc As AcadDocument = acApp.ActiveDocument
        Dim vPnt() As Double = {0.0, 0.0, 1.0}
        Dim vNpnt As Object
        Dim vOpnt(2) As Double
        Dim vAng As Object

        Dim centerPoint As Object
        Dim vSize As Object
        Dim cPViewport As AcadPViewport
        Dim returnPnt1 As Object
        Dim returnPnt2 As Object
        Dim x As Double, y As Double, z As Double
        Dim retdist As Double
        Dim retAngle As Double
        Dim vpcScale As Double
        Dim polarPnt As Object

        Try

            If doc.ActiveSpace = AcActiveSpace.acPaperSpace Then
                If doc.MSpace Then

                    doc.SetVariable("UCSFOLLOW", 0)

                    vNpnt = doc.Utility.TranslateCoordinates(vPnt, AcCoordinateSystem.acWorld, AcCoordinateSystem.acDisplayDCS, True)

                    vAng = doc.Utility.AngleFromXAxis(vOpnt, vNpnt)
                    vAng = 360.0# * Math.PI / 180 - vAng


                    centerPoint = doc.GetVariable("VIEWCTR")
                    centerPoint = doc.Utility.TranslateCoordinates(centerPoint, AcCoordinateSystem.acUCS, AcCoordinateSystem.acWorld, False)

                    vSize = doc.GetVariable("VIEWSIZE")

                    cPViewport = doc.ActivePViewport
                    cPViewport.Display(True)
                    cPViewport.ViewportOn = True
                    cPViewport.Visible = True

                    doc.MSpace = False

                    Try
                        ' Return a point using a prompt
                        returnPnt1 = doc.Utility.GetPoint(, "基点: ")

                        returnPnt2 = doc.Utility.GetPoint(returnPnt1, "移動位置を指定: ")
                    Catch
                        doc.MSpace = True
                        Exit Sub
                    End Try

                    'Distance & Angle
                    x = returnPnt1(0) - returnPnt2(0)
                    y = returnPnt1(1) - returnPnt2(1)
                    z = 0.0#
                    retdist = Math.Sqrt((Math.Sqrt((x ^ 2) + (y ^ 2)) ^ 2) + (z ^ 2))

                    retAngle = doc.Utility.AngleFromXAxis(returnPnt1, returnPnt2)

                    'Center Point
                    '              VPScale -> PolerPoint -distance
                    doc.MSpace = True
                    ' cPViewport
                    vpcScale = cPViewport.CustomScale

                    polarPnt = doc.Utility.PolarPoint(centerPoint, retAngle + vAng, retdist / vpcScale * -1.0#)
                    cPViewport.DisplayLocked = False

                    acApp.ZoomCenter(polarPnt, vSize)

                    cPViewport.CustomScale = vpcScale
                    cPViewport.DisplayLocked = True

                Else
                    MsgBox("ステータスバー「モデル」の状態で行ってください。")

                End If
            Else
                MsgBox("Paper空間の「モデル」の状態で行ってください。")
            End If

        Catch ex As Exception


        End Try

    End Sub

End Class