VB歴３年のPGです。
環境:VB6(SP5) WinXp

PictreBox上にLineを引いています。ボタンを押下するごとに、そのLineを90度、180度、270度に時計まわりで回転させたいと思います。
実現させるには、具体的にどのように実装すれば良いかわかりません。
ヒントをいただければ。幸いです。

> VB暦３年のPGです。

　　｜
　　｜　　
　　　＿＿
　　｜
　　｜
＿＿

> > VB暦３年のPGです。
>
> 　　｜
> 　　｜　　
> 　　　＿＿
> 　　｜
> 　　｜
> ＿＿

花ちゃん様

初歩的な間違いをしてしまい。申し訳ありません。
変換ミスをしておりました。
ご指摘ありがとうございます。

Formの中に
コマンドボタン一つと
ピクチャーボックス一つと
その中にライン一つ配置して
以下のコードでどうでしょう？

Option Explicit

Dim BT_CAPTION(4) As String

Private Sub Command1_Click()
    Select Case Command1.Caption
    Case BT_CAPTION(0)
        Line1.X2 = Line1.X1 + 1000
        Line1.Y2 = Line1.Y1
        Command1.Caption = BT_CAPTION(1)
    Case BT_CAPTION(1)
        Line1.X2 = Line1.X1
        Line1.Y2 = Line1.Y1 + 1000
        Command1.Caption = BT_CAPTION(2)
    Case BT_CAPTION(2)
        Line1.X2 = Line1.X1 - 1000
        Line1.Y2 = Line1.Y1
        Command1.Caption = BT_CAPTION(3)
    Case BT_CAPTION(3)
        Line1.X2 = Line1.X1
        Line1.Y2 = Line1.Y1 - 1000
        Command1.Caption = BT_CAPTION(0)
    End Select
End Sub

Private Sub Form_Load()
    BT_CAPTION(0) = "  0 →  90"
    BT_CAPTION(1) = " 90 → 180"
    BT_CAPTION(2) = "180 → 270"
    BT_CAPTION(3) = "270 →   0"
    Line1.X1 = Picture1.Width / 2
    Line1.Y1 = Picture1.Height / 2
    Command1.Caption = BT_CAPTION(0)
End Sub

Edward様

早急なご回答ありがとうございました。
貴重なお時間を使っていただき、せっかくご回答いただきましたが。

回転前のLineはPictureBox上に自由な角度(回転前のPictureBoxに対してLineは垂直や水平であるとは限らない)、自由な位置に存在している状態です。
そういった状態をそのまま回転させたいです。
++----------------------------------------------------------------------------++
実際のPGにはLineの下には画像があります。その画像に対し目印を付ける意味で自由にラインを描いています。回転後のイメージは、画像の角度は変わっているものの。画像に対しては、回転前と同じ位置にLineを描きたいと考えています。
++----------------------------------------------------------------------------++

下記を応用すればOKだと思います。RとTの現在値を調べる処理を付け加えればね。


Private Sub Command1_Click()
Static R As Integer, T As Double

R = Min(Me.Width / 2, Me.Height / 2)
T = T + Radian(90)
Line1.X1 = Me.Width / 2
Line1.Y1 = Me.Height / 2
Line1.X2 = R * Cos(T) + Line1.X1
Line1.Y2 = R * Sin(T) + Line1.Y1
End Sub

Private Function Radian(D As Double) As Double
    Radian = 3.14159 * D / 180
End Function

Private Function Min(A As Double, B As Double) As Double
    Min = IIf(A > B, B, A)
End Function

ダンボ様

早急なご回答ありがとうございます。
「Cos」や「Sin」の使用経験はなく。どのように応用すべきか？自分自身ですぐに答えはでていまんが。参考にさせていただきます。
まずは。お礼のみにて失礼させていただきます。。。

もういらないとは思いますが、RとTの現在値の取得を付け加えておきました。
(*)画像の回転は出来るんですよね。それでいてLINEの回転が出来ない？
(**)画像と線を同時に回転させたいということかしら？それなら画像の合成の方を指向すれば？

Option Explicit
Const PAI = 3.1415926
Dim R As Double, T As Double

Private Sub Command1_Click()
    T = T + Radian(90)
    Line1.X2 = R * Cos(T) + Line1.X1
    Line1.Y2 = R * Sin(T) + Line1.Y1
End Sub

Private Function Radian(D As Double) As Double
    Radian = PAI * D / 180
End Function

Private Function ArcTan(X As Double, Y As Double) As Double
    Select Case X
    Case Is > 0
        ArcTan = Atn(Y / X)
    Case Is < 0
        ArcTan = Atn(Y / X) + PAI
    Case Else
        ArcTan = Sgn(Y) * PAI / 2
    End Select
End Function

Private Sub Form_Load()
With Line1
    R = Sqr((.X2 - .X1) ^ 2 + (.Y2 - .Y1) ^ 2)
    T = ArcTan(.X2 - .X1, .Y2 - .Y1)
End With
End Sub

ダンボ様
おはようございます。
ご回答ありがとうございました。

> もういらないとは思いますが、RとTの現在値の取得を付け加えておきました。
昨日、色々悩み。家に帰ってから。Sin??Cos??・・・と、教科書をひっぱり出しで試行錯誤しておりました。
無事に解決しました。ありがとうございます。

> (*)画像の回転は出来るんですよね。それでいてLINEの回転が出来ない？
その通りです。

> (**)画像と線を同時に回転させたいということかしら？それなら画像の合成の方を指向すれば？
そのようにしたいのですが。仕様的にNGなのです。。。

追加のご相談です。

「90度、180度、270度の回転」ということでしたが。。。
左右回転も対応する必要があります。
※回転方法以外は、同じ仕様です。画像の左右回転は、出来ています。

以上　よろしくお願いします。

> 左右回転も対応する必要があります。

左右回転って何？　
線対称の反転ってことですか？

Line.X1 = PictureBox.ScaleWidth - Line.X1
Line.X2 = PictureBox.ScaleWidth - Line.X2

これだと、PictureBoxの中心を軸にした線対象になりますが、、、

あと、、PictureBox.Scale (-1, 1)-(1, -1)で、
PictureBoxのScaleModeを変更しておけば、
Line1.X1 = -Line1.X1
Line1.X2 = -Line1.X2
みたいに符号を変えるだけで反転可能。
これを応用すれば、90度毎の回転もより簡単になりますよ。。。

的外れなら、ごめんなさい。。。

BT様
早々のご回答ありがとうございます。

> 左右回転って何？　
> 線対称の反転ってことですか？
はい。そうです。線対称の反転のことです。

> 的外れなら、ごめんなさい。。。
いえいえ。的外れではないです。

以下のようなソースを書いたのですが。線対称反転の場合、画像がおかしく(前回の画像の残像が残る)なります。
画像側の処理がおかしいのでしょうか？？


Dim countNum As Long
Dim sngWidth As Single        '絵の幅(ピクセル)
Dim sngHeight As Single       '絵の高さ(ピクセル)


Private Sub Command1_Click()

If countNum Mod 2 <> 0 Then

     Picture2.Picture = Picture1.Picture
    
     With Picture2
        sngWidth = .ScaleX(.ScaleWidth, .ScaleMode, vbPixels)
        sngHeight = .ScaleY(.ScaleHeight, .ScaleMode, vbPixels)
    End With
        
Else

     With Picture2
        .Parent.ScaleMode = vbPixels
        .ScaleMode = vbPixels
        
        'サイズ調整、枠有り無しどちらでもOK
        .Move .Left, .Top, sngWidth + (.Width - .ScaleWidth), _
                                    sngHeight + (.Height - .ScaleHeight)
                                    
        .Refresh '(AutoRedraw=False)用
        '左右の鏡像の場合
        .PaintPicture Picture1.Picture, sngWidth - 1, 0, -sngWidth
        
    End With
End If

countNum = countNum + 1
    
Line1.X1 = Picture2.ScaleWidth - Line1.X1
Line1.X2 = Picture2.ScaleWidth - Line1.X2
  
    
End Sub

Private Sub Form_Load()
    Picture1.Visible = False
    
    Picture1.Picture = LoadPicture("C:\sample.bmp")
    
     With Picture2
        sngWidth = .ScaleX(.ScaleWidth, .ScaleMode, vbPixels)
        sngHeight = .ScaleY(.ScaleHeight, .ScaleMode, vbPixels)
    End With

    countNum = 1
End Sub

> 画像がおかしく(前回の画像の残像が残る)なります。

ななさんのコードを実行してみましたが、私の環境では再現しないようです。

どうしても残像が残るのであれば、

  call Picture2.Cls

で前回の画像をクリアしてから再描画すれば、確実かと思います。

BT6様

ご回答ありがとうございました。返信が遅くなり申し訳ありません。
他の作業を優先していたのと、この件を解決できず少し悩んでいました。

原因は、AutoRedraw プロパティが「False」になっていた為
背景の残像が残っていました。

無事に解決することができました。

ありがとうございました。

> 左右回転も対応する必要があります。

あくまでも数学理論で進みます。左右反転ということは、
T→PAI-T
ってことです。だから

Private Sub Command2_Click()
    T = PAI - T
    Line1.X2 = R * Cos(T) + Line1.X1
    Line1.Y2 = R * Sin(T) + Line1.Y1
End Sub

でいいと思いますよ。試験していないので自信度90%くらいかな。
(汎用的にコーディングしてあると応用がすごく楽)

> でいいと思いますよ。試験していないので自信度90%くらいかな。

はい。試験しました。OKですね。
さあ、次は何かな？回転・反転・・・・移動かな？

ダンボ様

回転と、左右回転のアドバイス。テストなど
ご回答ありがとうございます。

「解決した」と思っていましたが、画像も同時に回転してみると問題がありました。
教えていただいたソースを組込むとx1,y1を中心に回転しており、画像にラインがついてきていません・・・。

左右回転も、同様でした・・・。

以下は回転のソースです。

Option Explicit

Private Declare Function CreateCompatibleDC Lib "gdi32" _
                        (ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" _
                        (ByVal hDC As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" _
                        (ByVal hDC As Long, _
                         ByRef pBitmapInfo As BITMAPINFO, _
                         ByVal un As Long, _
                         ByRef lplpVoid As Long, _
                         ByVal handle As Long, _
                         ByVal dw As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" _
                        (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
                        (ByVal hDC As Long, _
                         ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" _
                        (ByVal hDestDC As Long, _
                         ByVal X As Long, _
                         ByVal Y As Long, _
                         ByVal nWidth As Long, _
                         ByVal nHeight As Long, _
                         ByVal hSrcDC As Long, _
                         ByVal xSrc As Long, _
                         ByVal ySrc As Long, _
                         ByVal dwRop As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" _
                        (ByVal aHDC As Long, _
                         ByVal hBitmap As Long, _
                         ByVal nStartScan As Long, _
                         ByVal nNumScans As Long, _
                         ByRef lpBits As Any, _
                         ByRef lpBI As BITMAPINFO, _
                         ByVal wUsage As Long) As Long
Private Declare Function SetDIBits Lib "gdi32" _
                        (ByVal hDC As Long, _
                         ByVal hBitmap As Long, _
                         ByVal nStartScan As Long, _
                         ByVal nNumScans As Long, _
                         ByRef lpBits As Any, _
                         ByRef lpBI As BITMAPINFO, _
                         ByVal wUsage As Long) As Long
Private Type BITMAPINFOHEADER
  biSize As Long
  biWidth As Long
  biHeight As Long
  biPlanes As Integer
  biBitCount As Integer
  biCompression As Long
  biSizeImage As Long
  biXPelsPerMeter As Long
  biYPelsPerMeter As Long
  biClrUsed As Long
  biClrImportant As Long
End Type
Private Type RGBQUAD
  rgbBlue As Byte
  rgbGreen As Byte
  rgbRed As Byte
  rgbReserved As Byte
End Type
Private Type BITMAPINFO
  bmiHeader As BITMAPINFOHEADER
  bmiColors As RGBQUAD
End Type

Const PAI = 3.1415926
Dim R As Double
Dim T As Double

'ピクチャボックスを90度回転させます
Public Sub PicRot90(ByRef myPicture As PictureBox)
Const SRCCOPY = &HCC0020
Const DIB_RGB_COLORS = 0&
Const BI_RGB = 0&
  Dim myContainer As Object
  Dim intScaleMode As Integer
  Dim sngScaleWidth As Single
  Dim sngScaleHeight As Single
  Dim sngScaleLeft As Single
  Dim sngScaleTop As Single
  Dim lngWidth As Long
  Dim lngHeight As Long
  Dim XX As Long
  Dim YY As Long
  Dim hDC_Temp As Long
  Dim hDC_Object As Long
  Dim hBitmap As Long
  Dim ppvBits As Long
  Dim myBMPINFO As BITMAPINFO
  Dim myBMPINFO1 As BITMAPINFO
  Dim myBMPINFO2 As BITMAPINFO
  Dim lngArray() As Long
  Dim lngArray2() As Long
  Dim blnAutoRedraw As Boolean
  Dim blnVisible As Boolean
  Dim lngResult As Long

  With myPicture
    '継続表示属性でなかった絵は消えます
    blnAutoRedraw = .AutoRedraw
    .AutoRedraw = True

    '表示画像サイズ取得
    lngWidth = .ScaleX(.ScaleWidth, .ScaleMode, vbPixels)
    lngHeight = .ScaleY(.ScaleHeight, .ScaleMode, vbPixels)

    '作業用hDC取得
    hDC_Temp = CreateCompatibleDC(.hDC)
    '作業用hBitmap作成
    With myBMPINFO
      With .bmiHeader
        .biSize = LenB(myBMPINFO.bmiHeader)
        .biWidth = lngWidth
        .biHeight = lngHeight
        .biPlanes = 1
        .biBitCount = 32
        .biCompression = BI_RGB
      End With
    End With
    hBitmap = CreateDIBSection(hDC_Temp, myBMPINFO, DIB_RGB_COLORS, ppvBits, 0, 0)

    '画像コピー(現在のコントロールサイズ分)
    hDC_Object = SelectObject(hDC_Temp, hBitmap)
    lngResult = BitBlt(hDC_Temp, 0, 0, lngWidth, lngHeight, .hDC, 0, 0, SRCCOPY)
    Call SelectObject(hDC_Temp, hDC_Object)

    '元画像用の配列を確保
    ReDim lngArray(0 To lngWidth - 1, 0 To lngHeight - 1)

    '画像コピーから色配列取得
    myBMPINFO1.bmiHeader.biSize = Len(myBMPINFO1.bmiHeader)
    lngResult = GetDIBits(hDC_Temp, hBitmap, 0, lngHeight, ByVal 0&, _
         myBMPINFO1, DIB_RGB_COLORS)
    lngResult = GetDIBits(hDC_Temp, hBitmap, 0, lngHeight, lngArray(0, 0), _
        myBMPINFO1, DIB_RGB_COLORS)
    '作業用hBitMapを削除
    Call DeleteObject(hBitmap)

    '加工用の配列を確保
    ReDim lngArray2(0 To lngHeight - 1, 0 To lngWidth - 1)

    '色配列を加工(時計回りに90度)
    For YY = 0 To lngHeight - 1
        For XX = 0 To lngWidth - 1
          lngArray2(YY, (lngWidth - 1) - XX) = lngArray(XX, YY)
        Next
    Next

    '加工後のhBitmap作成
    With myBMPINFO
      With .bmiHeader
        .biSize = LenB(myBMPINFO.bmiHeader)
        .biWidth = lngHeight
        .biHeight = lngWidth
        .biPlanes = 1
        .biBitCount = 32
        .biCompression = BI_RGB
      End With
    End With
    hBitmap = CreateDIBSection(hDC_Temp, myBMPINFO, DIB_RGB_COLORS, ppvBits, 0, 0)

    '色配列をBitmapへ
    myBMPINFO2.bmiHeader.biSize = Len(myBMPINFO2.bmiHeader)
    lngResult = GetDIBits(hDC_Temp, hBitmap, 0, lngWidth, ByVal 0&, myBMPINFO2, DIB_RGB_COLORS)
    'GetDIBits後でなければSetDIBitsに失敗するので
    lngResult = GetDIBits(hDC_Temp, hBitmap, 0, lngWidth, lngArray(0, 0), _
       myBMPINFO2, DIB_RGB_COLORS)
    Erase lngArray  '不要
    lngResult = SetDIBits(hDC_Temp, hBitmap, 0, lngWidth, lngArray2(0, 0), _
       myBMPINFO2, DIB_RGB_COLORS)
    Erase lngArray2 '不要

    'コンテナ移動が発生するのを隠すのが主な目的
    blnVisible = .Visible
'    .Visible = False

    'コンテナをフォームに(コントロール位置・サイズ変更計算簡略化の為)
    Set myContainer = .Container
    Set .Container = .Parent

    'フォームのScaleを保存
    With .Parent
      intScaleMode = .ScaleMode
      If .ScaleMode = vbUser Then
        sngScaleLeft = .ScaleLeft
        sngScaleTop = .ScaleTop
        sngScaleWidth = .ScaleWidth
        sngScaleHeight = .ScaleHeight
      End If
      .ScaleMode = vbPixels
    End With

    'コントロール位置・サイズを調整
    .Move .Left, .Top, .Height, .Width
  

    'ピクチャボックスへ転記
    hDC_Object = SelectObject(hDC_Temp, hBitmap)
    lngResult = BitBlt(.hDC, 0, 0, lngHeight, lngWidth, hDC_Temp, 0, 0, SRCCOPY)
    Call SelectObject(hDC_Temp, hDC_Object)

    '不要になったハンドルを削除
    Call DeleteObject(hBitmap)
    Call DeleteDC(hDC_Temp)

    '元の状態へ戻す
    With .Parent
      If intScaleMode = vbUser Then
        .ScaleLeft = sngScaleLeft
        .ScaleTop = sngScaleTop
        .ScaleWidth = sngScaleWidth
        .ScaleHeight = sngScaleHeight
      Else
        .ScaleMode = intScaleMode
      End If
    End With
    Set .Container = myContainer
    .Visible = blnVisible
    .AutoRedraw = blnAutoRedraw
  End With
End Sub


Private Sub Command1_Click()

    Picture1.Visible = False
    Call PicRot90(Picture1)
    Picture1.Visible = True

    T = T + Radian(90)
    Line1.X2 = R * Cos(T) + Line1.X1
    Line1.Y2 = R * Sin(T) + Line1.Y1

End Sub

Private Sub Form_Load()
    Picture1.Picture = LoadPicture("C:\sample.bmp")
    
    With Line1
        R = Sqr((.X2 - .X1) ^ 2 + (.Y2 - .Y1) ^ 2)
        T = ArcTan(.X2 - .X1, .Y2 - .Y1)
    End With
        
End Sub

Private Function Radian(D As Double) As Double
    Radian = PAI * D / 180
End Function

Private Function ArcTan(X As Double, Y As Double) As Double
    Select Case X
    Case Is > 0
        ArcTan = Atn(Y / X)
    Case Is < 0
        ArcTan = Atn(Y / X) + PAI
    Case Else
        ArcTan = Sgn(Y) * PAI / 2
    End Select
End Function

> 教えていただいたソースを組込むとx1,y1を中心に回転しており、画像にラインがついてきていません・・・。

提示したサンプルはそういう仕様だもの。。
画像の回転中心(反転軸)とLine1の回転中心(反転軸)を合わせないと。



ヒント：
斜め読みですが、画像の回転中心はピクチャーボックスの真ん中。
反転も恐らくピクチャーボックスの中心を通るX軸、Y軸みたいですね。

ダンボ様

いつも早々のご回答ありがとうございます。
下記を参考にさせていただきます。
少し考えてみましたが、なんとかうまくいきそうな感触を持ちました。

> 提示したサンプルはそういう仕様だもの。。
> 画像の回転中心(反転軸)とLine1の回転中心(反転軸)を合わせないと。
>
> ヒント：
> 斜め読みですが、画像の回転中心はピクチャーボックスの真ん中。
> 反転も恐らくピクチャーボックスの中心を通るX軸、Y軸みたいですね。

編集2時間、試験30秒くらいかな。
1次元が2次元になる場合はコード量は2倍ではなく2乗になることを痛感しました。
コマンド処理最後の    Call DLine2Shape(DLine1, Line1)は
Set Line1 = DLine2Shape(DLine1)のようなインタフェースにしたかったが
コンパイルエラーが取れずに逃げました。誰か教えて。


Option Explicit
Const PAI = 3.1415926
Private Type PPoint
    R As Double
    T As Double
End Type
Private Type DPoint
    X As Double
    Y As Double
End Type
Private Type PLine
    P1 As PPoint
    P2 As PPoint
End Type
Private Type DLine
    D1 As DPoint
    D2 As DPoint
End Type

Private Sub Command3_Click()
Dim DLine1 As DLine, PLine1 As PLine, Org As DPoint

    Org.X = Picture1.Width / 2
    Org.Y = Picture1.Height / 2
    
    DLine1 = Shape2DLine(Line1)
    DLine1 = DLine2NewDeca(DLine1, Org)
    PLine1 = DLine2PLine(DLine1)
    PLine1 = RotatePLine(PLine1, Radian(90))
    DLine1 = PLine2DLine(PLine1)
    DLine1 = DLine2OrgDeca(DLine1, Org)
    Call DLine2Shape(DLine1, Line1)

End Sub

Private Sub Command4_Click()
Dim DLine1 As DLine, PLine1 As PLine, Org As DPoint

    Org.X = Picture1.Width / 2
    Org.Y = Picture1.Height / 2
    
    DLine1 = Shape2DLine(Line1)
    DLine1 = DLine2NewDeca(DLine1, Org)
    PLine1 = DLine2PLine(DLine1)
    PLine1 = ReversePLine(PLine1, "X")
    PLine1 = ReversePLine(PLine1, "Y")
    DLine1 = PLine2DLine(PLine1)
    DLine1 = DLine2OrgDeca(DLine1, Org)
    Call DLine2Shape(DLine1, Line1)

End Sub

Private Function DLine2NewDeca(DLine1 As DLine, Org As DPoint) As DLine
    DLine2NewDeca.D1 = DPoint2NewDeca(DLine1.D1, Org)
    DLine2NewDeca.D2 = DPoint2NewDeca(DLine1.D2, Org)
End Function

Private Function DPoint2NewDeca(Deca1 As DPoint, Org As DPoint) As DPoint
    DPoint2NewDeca.X = Deca1.X - Org.X
    DPoint2NewDeca.Y = Deca1.Y - Org.Y
End Function

Private Function DLine2OrgDeca(DLine1 As DLine, Org As DPoint) As DLine
    DLine2OrgDeca.D1 = DPoint2OrgDeca(DLine1.D1, Org)
    DLine2OrgDeca.D2 = DPoint2OrgDeca(DLine1.D2, Org)
End Function

Private Function DPoint2OrgDeca(Deca1 As DPoint, Org As DPoint) As DPoint
    DPoint2OrgDeca.X = Deca1.X + Org.X
    DPoint2OrgDeca.Y = Deca1.Y + Org.Y
End Function

Private Function Shape2DLine(Line1 As Line) As DLine
    Shape2DLine.D1.X = Line1.X1
    Shape2DLine.D1.Y = Line1.Y1
    Shape2DLine.D2.X = Line1.X2
    Shape2DLine.D2.Y = Line1.Y2
End Function

Private Function DLine2Shape(DLine1 As DLine, Line1 As Line)  ' As Line
    Line1.X1 = DLine1.D1.X
    Line1.Y1 = DLine1.D1.Y
    Line1.X2 = DLine1.D2.X
    Line1.Y2 = DLine1.D2.Y
End Function

Private Function Line_on_PPoint(DLine1 As DLine) As PLine
    DLine2NewDeca.D1 = DPoint2NewDeca(DLine1.D1, Org)
    DLine2NewDeca.D2 = DPoint2NewDeca(DLine1.D2, Org)
End Function

Private Function DLine2PLine(DLine1 As DLine) As PLine
    DLine2PLine.P1 = DPoint2PPoint(DLine1.D1)
    DLine2PLine.P2 = DPoint2PPoint(DLine1.D2)
End Function

Private Function DPoint2PPoint(DPoint1 As DPoint) As PPoint
    DPoint2PPoint.R = Sqr(DPoint1.X ^ 2 + DPoint1.Y ^ 2)
    DPoint2PPoint.T = ArcTan(DPoint1.X, DPoint1.Y)
End Function

Private Function PLine2DLine(PLine1 As PLine) As DLine
    PLine2DLine.D1 = PPoint2DPoint(PLine1.P1)
    PLine2DLine.D2 = PPoint2DPoint(PLine1.P2)
End Function

Private Function PPoint2DPoint(PPoint1 As PPoint) As DPoint
    PPoint2DPoint.X = PPoint1.R * Cos(PPoint1.T)
    PPoint2DPoint.Y = PPoint1.R * Sin(PPoint1.T)
End Function

Private Function RotatePLine(PLine1 As PLine, DT As Double) As PLine
    RotatePLine.P1 = RotatePPoint(PLine1.P1, DT)
    RotatePLine.P2 = RotatePPoint(PLine1.P2, DT)
End Function

Private Function RotatePPoint(PPoint1 As PPoint, DT As Double) As PPoint
    RotatePPoint.R = PPoint1.R
    RotatePPoint.T = PPoint1.T + DT
End Function

Private Function ReversePLine(PLine1 As PLine, DR As String) As PLine
    ReversePLine.P1 = ReversePPoint(PLine1.P1, DR)
    ReversePLine.P2 = ReversePPoint(PLine1.P2, DR)
End Function

Private Function ReversePPoint(PPoint1 As PPoint, DR As String) As PPoint
    ReversePPoint.R = PPoint1.R
    Select Case DR
    Case "X"
        ReversePPoint.T = -PPoint1.T
    Case "Y"
        ReversePPoint.T = PAI - PPoint1.T
    Case Else
        Stop
    End Select
End Function

Private Function Radian(D As Double) As Double
    Radian = PAI * D / 180
End Function

Private Function ArcTan(X As Double, Y As Double) As Double
    Select Case X
    Case Is > 0
        ArcTan = Atn(Y / X)
    Case Is < 0
        ArcTan = Atn(Y / X) + PAI
    Case Else
        ArcTan = Sgn(Y) * PAI / 2
    End Select
End Function

ダンボ様

いつも、早々のご回答ありがとうございます。
返信が遅くなり大変申し訳ないです。
(急ぎで他の作業と、この件に関し自分なりに悪戦苦闘していました。)

途中まではうまくいきかけていましたが、やはり完全に詰まってしまい
教えていただいたソースを拝見させていただき「解決」しました。

ありがとうございます。