Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

3 points parabola drawinng using VBA

Status
Not open for further replies.

kkaesaem

Structural
Aug 25, 2019
2
0
0
KR
Below is the code of Parabola with 3 points in VBA
para_rtsxlo.png


'-----------------------------------------------------------Code
Sub para()

Dim Pnt1, Pnt2, Pnt3 As Variant '3points for parabola

Pnt1 = ThisDrawing.Utility.GetPoint(, "1st Point")
Pnt2 = ThisDrawing.Utility.GetPoint(, "2nd Point")
Pnt3 = ThisDrawing.Utility.GetPoint(, "3rd Point")

Dim a, b, c As Double
Dim M11, M12, M13, M21, M22, M23, M31, M32, M33 As Double
Dim x1, x2, x3, y1, y2, y3, plusx, plusy As Double

plusx = Pnt1(0) + Pnt3(0)
plusy = Pnt1(1) + Pnt3(1)

x1 = Pnt1(0) + plusx: x2 = Pnt2(0) + plusx: x3 = Pnt3(0) + plusx
y1 = Pnt1(1) + plusy: y2 = Pnt2(1) + plusy: y3 = Pnt3(1) + plusy

M11 = 1 / (x1 ^ 2 - x1 * x2 - x1 * x3 + x2 * x3)
M12 = 1 / (x2 ^ 2 - x1 * x2 + x1 * x3 - x2 * x3)
M13 = 1 / (x3 ^ 2 + x1 * x2 - x1 * x3 - x2 * x3)

M21 = -(x2 + x3) / (x1 ^ 2 - x1 * x2 - x1 * x3 + x2 * x3)
M22 = -(x1 + x3) / (x2 ^ 2 - x1 * x2 + x1 * x3 - x2 * x3)
M23 = -(x1 + x2) / (x3 ^ 2 + x1 * x2 - x1 * x3 - x2 * x3)

M31 = -(x1 * x3) * (x2 ^ 2 - x2 * x3) / (x1 ^ 2 - x1 * x3) / (x2 ^ 2 - x1 * x2 + x1 * x3 - x2 * x3)
M32 = (x1 * x3) / (x2 ^ 2 - x1 * x2 + x1 * x3 - x2 * x3)
M33 = -(x1 * x3) * (x2 ^ 2 - x1 * x2) / (x3 ^ 2 - x1 * x3) / (x2 ^ 2 - x1 * x2 + x1 * x3 - x2 * x3)

a = M11 * y1 + M12 * y2 + M13 * y3
b = M21 * y1 + M22 * y2 + M23 * y3
c = M31 * y1 + M32 * y2 + M33 * y3

Dim n As Integer
n = InputBox("What is the number of divided parabola?")

Dim interval As Double
interval = (x3 - x1) / n

Dim polyPnt() As Double
ReDim polyPnt(2 * n + 1) As Double

Dim i As Integer

For i = 0 To n

polyPnt(i * 2) = x1 + interval * i
polyPnt(i * 2 + 1) = a * polyPnt(i * 2) ^ 2 + b * polyPnt(i * 2) + c

Next i

Dim Opnt1(2) As Double
Dim Opnt2(2) As Double

Opnt1(0) = 0: Opnt1(1) = 0: Opnt1(2) = 0
Opnt2(0) = -plusx: Opnt2(1) = -plusy: Opnt2(2) = 0

Dim polyObj As AcadLWPolyline

Set polyObj = ThisDrawing.ModelSpace.AddLightWeightPolyline(polyPnt)
polyObj.Move Opnt1, Opnt2

End Sub
'-----------------------------------------------------------Code


Regards,
Kkaesaem
 
Status
Not open for further replies.
Back
Top