Hello,How to create triangle with sides 3, 5, 6 cm using CreatePolygon or one other way using VBA?Greetings?
I'm sorry, but my VBA skills are minimal, this code was translated from my C# code with ChatGPT, but I saw that to create the points it changed from Math to ActiveDocument
Apparently the Math object in VBA is a member of the Document object, I edited my post correcting the code
Hello,Your code work well for corelDRAW X5 and abovePlease change code to work for corelDRAW X3. CenterX, CenterY properties must be replaced with some with same functionality (LeftX, RightX, TopY, BottomY, width/2, hight/2......)Greetings!
Maybe this works. I cant check. Dont have X3.
Have used User Click to specify where to draw the triangle.
Sub TriangleSSS()Dim x1#, y1#, x2#, y2#Dim b As BooleanDim mShift& 'Required for GetUserClickDim s As Shape ' BaseDim c1 As Shape, c2 As Shape ' ArcsDim cps As CrossPointsDim sp As SubPathDim l1#, l2#, l3# 'lengthsl1 = 3l2 = 5l3 = 6b = ActiveDocument.GetUserClick(x1, y1, mShift, 10, True, cdrCursorWinCross)If Not b Then x2 = x1 + l1 y2 = y1 Set c1 = ActiveLayer.CreateEllipse2(x1, y1, l2, l2, 180, 360) Set c2 = ActiveLayer.CreateEllipse2(x2, y2, l3, l3, 180, 360) Set cps = c1.DisplayCurve.SubPaths(1).GetIntersections(c2.DisplayCurve.SubPaths(1)) c1.Delete c2.Delete If cps.Count > 0 Then Set s = ActiveLayer.CreateLineSegment(x1, y2, x2, y2) ' Triangle Base Set sp = s.Curve.SubPaths(1) sp.AppendLineSegment cps(1).PositionX, cps(1).PositionY, False sp.AppendLineSegment cps(1).PositionX, cps(1).PositionY, True s.Curve.Closed = True Else MsgBox "Sides will not intersect" End IfEnd IfEnd Sub
I try install a X3 version but dont works, I think this code will work in X3, I lowered the API usage
[CgsAddInMacro] public Shape CreateTriangle2(double a, double b, double c) { double AX = 0, AY = 0; if (a > Math.Abs(b - c) && a < b + c && b > Math.Abs(a - c) && b < a + c && c > Math.Abs(a - b) && c < a + b) { double cosA = (Math.Pow(b, 2) + Math.Pow(c, 2) - Math.Pow(a, 2)) / (2 * b * c); double anguloA = Math.Acos(cosA); double alpha = anguloA * (180 / Math.PI); double BX = AX + b; double BY = AY; double CX = AX + c * Math.Cos(alpha * Math.PI / 180); double CY = AY + c * Math.Sin(alpha * Math.PI / 180); Curve cur = corelApp.CreateCurve(corelApp.ActiveDocument); SubPath sp = cur.CreateSubPath(AX, AY); sp.AppendLineSegment(BX, BY); sp.AppendLineSegment(CX, CY); sp.AppendLineSegment(AX, AY); return corelApp.ActiveLayer.CreateCurve(cur); } else throw new Exception("These measurements do not form a triangle"); }
Function CreateTriangle2(ByVal a As Double, ByVal b As Double, ByVal c As Double) As Shape Dim AX As Double, AY As Double AX = 0 AY = 0
If a > Abs(b - c) And a < b + c And b > Abs(a - c) And b < a + c And c > Abs(a - b) And c < a + b Then Dim cosA As Double Dim anguloA As Double Dim alpha As Double Dim BX As Double Dim BY As Double Dim CX As Double Dim CY As Double
cosA = (b ^ 2 + c ^ 2 - a ^ 2) / (2 * b * c)
anguloA = Acos(cosA)
alpha = anguloA * (180 / Pi)
BX = AX + b BY = AY
CX = AX + c * Cos(alpha * Pi / 180) CY = AY + c * Sin(alpha * Pi / 180)
Dim cur As Curve Set cur = CreateCurve(ActiveDocument) Dim sp As SubPath Set sp = cur.CreateSubPath(AX, AY) sp.AppendLineSegment BX, BY sp.AppendLineSegment CX, CY sp.AppendLineSegment AX, AY
Set CreateTriangle2 = ActiveLayer.CreateCurve(cur) Else Err.Raise vbObjectError + 1, "CreateTriangle2", "These measurements do not form a triangle" End IfEnd Function
I couldn't test VBA