Hello,How to create triangle with sides 3, 5, 6 cm using CreatePolygon or one other way using VBA?Greetings?
Geometry 6th grade of secondary school
Sub CreateTriangle_3_5_6cm() Dim s As Shape, s1 As Shape, s2 As Shape, cpR As CrossPoints Dim a As Double, b As Double, c As Double, X As Double, Y As Double ActiveDocument.Unit = cdrMillimeter a = 60 b = 50 c = 30 Set s = ActiveLayer.CreateLineSegment(50, 50, 50 + a, 50) Set s1 = ActiveLayer.CreateEllipse2(100, 100, b, b) s1.ConvertToCurves Set s2 = ActiveLayer.CreateEllipse2(100, 100, c, c) s2.ConvertToCurves s1.CenterX = s.Curve.Nodes(1).PositionX s1.CenterY = s.Curve.Nodes(1).PositionY s2.CenterX = s.Curve.Nodes(2).PositionX s2.CenterY = s.Curve.Nodes(2).PositionY
Set cpR = s1.Curve.SubPaths(1).GetIntersections(s2.Curve.SubPaths(1), cdrAbsoluteSegmentOffset) X = cpR.Item(2).PositionX Y = cpR.Item(2).PositionY s1.Delete s2.Delete Set s1 = ActiveLayer.CreateLineSegment(s.Curve.Nodes(1).PositionX, s.Curve.Nodes(1).PositionY, X, Y) Set s2 = ActiveLayer.CreateLineSegment(s.Curve.Nodes(2).PositionX, s.Curve.Nodes(2).PositionY, X, Y)End SubGet in touch if you need anythingBest regardsTaras
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