【Word VBA】直線で楕円描画マクロ▽ソースコード

Option Explicit

Option Base 0

'

Public Sub 直線で楕円描画マクロ()

   Const LNELCXPT = 200                   '中心位置（Ｘ）

   Const LNELCYPT = 160                   '　　　　（Ｙ）

   '

   Const LNELUVAL = 0.4                   '内円の位置係数

   Const LNELVVAL = 0.1                   '

   '

   Const LNELOFSX = 100                  '内円の傾き係数

   Const LNELOFSY = 90

   '

   Const LNELLNCL = &H5AFF            '線の色（オレンジ）

   Const LNELLNWT = 1                    '線の太さ

   '---------------------------------------------------------------------------

   Dim Ip As Integer

   Dim sngKpt As Single

   Dim sngXp0 As Single, sngYp0 As Single

   Dim sngXp1 As Single, sngYp1 As Single

   Dim sngXp2 As Single, sngYp2 As Single

   Dim sngXp3 As Single, sngYp3 As Single

   Dim sngMva As Single, sngAva As Single

   Dim sngd4v As Single

   Dim sngGX2 As Single, sngGX3 As Single

   Dim sngGY2 As Single, sngGY3 As Single

   '

   For sngKpt = 0 To 6.28 Step 0.1

       sngXp0 = Cos(sngKpt)

       sngYp0 = Sin(sngKpt)

       sngXp1 = 0.5 * (sngXp0 + LNELUVAL)

       sngYp1 = 0.5 * (sngYp0 + LNELVVAL)

       If (sngYp0 - LNELVVAL) <> 0 Then

          sngMva = (LNELUVAL - sngXp0) / (sngYp0 - LNELVVAL)

          sngAva = sngMva * sngXp1 - sngYp1

          sngd4v = 1 + sngMva * sngMva - sngAva * sngAva

          '

          sngXp2 = (sngMva * sngAva + Sqr(sngd4v)) _

                 / (1 + sngMva * sngMva)

          sngXp3 = (sngMva * sngAva - Sqr(sngd4v)) _

                 / (1 + sngMva * sngMva)

          '

          sngYp2 = sngMva * (sngXp2 - sngXp1) + sngYp1

          sngYp3 = sngMva * (sngXp3 - sngXp1) + sngYp1

          '

          sngGX2 = LNELCXPT + LNELOFSX * sngXp2

          sngGY2 = LNELCYPT - LNELOFSY * sngYp2

          sngGX3 = LNELCXPT + LNELOFSX * sngXp3

          sngGY3 = LNELCYPT - LNELOFSY * sngYp3

          '

          With ActiveDocument.Shapes.AddLine( _

               sngGX2, sngGY2, sngGX3, sngGY3).Line

              .ForeColor = LNELLNCL

              .Weight = LNELLNWT

          End With

      End If

   Next sngKpt

End Sub

【補足】

　講談社ブルーバックス

　木村良夫著「パソコンで遊ぶ数学」を参考にしました。