Hi,is there any way to convert a curve into another whenever it is present in a shape? I have these two shapes (image below) and I want to convert all the curves that are equal tothat triangle (wrong one) to a single line like in the example (right one). (I'm using VBA to do it, if necessary I can provide a .plt file with an example of these two shapes)
If anyone can help me with this I'll be very grateful
Please resent!
Done
Sub test_it() Dim s As Shape Dim noderangeThis As New NodeRange Set s = ActiveShape examine_curve_and_identify_sharp_point_nodes s.Curve, 89, noderangeThis noderangeThis.Delete Refresh End Sub Function examine_curve_and_identify_sharp_point_nodes(ByVal SourceCurve As Curve, ByVal CPAngleTolerance As Double, ByRef SharpPointNodeRange As NodeRange) As Boolean Dim nodeThis As Node Dim lngNodeIndex_subpath_getting As Long Dim subPathThis As SubPath Dim dif_x, dif_y As Double On Error GoTo ErrHandler For Each subPathThis In SourceCurve.SubPaths If subPathThis.Closed Then For lngNodeIndex_subpath_getting = 1 To subPathThis.Nodes.Count Set nodeThis = subPathThis.Nodes(lngNodeIndex_subpath_getting) If nodeThis.Type = cdrCuspNode Then If nodeThis.Segment.Type = cdrLineSegment And nodeThis.NextSegment.Type = cdrLineSegment Then 'MsgBox (nodeThis.PositionX) If lngNodeIndex_subpath_getting = 1 Then MsgBox ("primeiro") dif_x = (subPathThis.Nodes(lngNodeIndex_subpath_getting + 1).PositionX - subPathThis.Nodes(subPathThis.Nodes.Count).PositionX) / 2 dif_y = (subPathThis.Nodes(lngNodeIndex_subpath_getting + 1).PositionY - subPathThis.Nodes(subPathThis.Nodes.Count).PositionY) / 2 subPathThis.Nodes(subPathThis.Nodes.Count).PositionX = subPathThis.Nodes(subPathThis.Nodes.Count).PositionX + dif_x subPathThis.Nodes(subPathThis.Nodes.Count).PositionY = subPathThis.Nodes(subPathThis.Nodes.Count).PositionY + dif_y subPathThis.Nodes(lngNodeIndex_subpath_getting + 1).PositionX = subPathThis.Nodes(lngNodeIndex_subpath_getting + 1).PositionX - dif_x subPathThis.Nodes(lngNodeIndex_subpath_getting + 1).PositionY = subPathThis.Nodes(lngNodeIndex_subpath_getting + 1).PositionY - dif_y Else If AnglesAreClose(nodeThis.Segment.EndingControlPointAngle, nodeThis.NextSegment.StartingControlPointAngle, CPAngleTolerance) Then dif_x = (subPathThis.Nodes(lngNodeIndex_subpath_getting + 1).PositionX - subPathThis.Nodes(lngNodeIndex_subpath_getting - 1).PositionX) / 2 dif_y = (subPathThis.Nodes(lngNodeIndex_subpath_getting + 1).PositionY - subPathThis.Nodes(lngNodeIndex_subpath_getting - 1).PositionY) / 2 subPathThis.Nodes(lngNodeIndex_subpath_getting - 1).PositionX = subPathThis.Nodes(lngNodeIndex_subpath_getting - 1).PositionX + dif_x subPathThis.Nodes(lngNodeIndex_subpath_getting - 1).PositionY = subPathThis.Nodes(lngNodeIndex_subpath_getting - 1).PositionY + dif_y subPathThis.Nodes(lngNodeIndex_subpath_getting + 1).PositionX = subPathThis.Nodes(lngNodeIndex_subpath_getting + 1).PositionX - dif_x subPathThis.Nodes(lngNodeIndex_subpath_getting + 1).PositionY = subPathThis.Nodes(lngNodeIndex_subpath_getting + 1).PositionY - dif_y End If End If End If End If Next lngNodeIndex_subpath_getting End If Next subPathThis ExitFunc: Exit Function ErrHandler: MsgBox "Error occurred: " & Err.Description & vbCrLf & vbCrLf & "examine_curve_and_identify_sharp_point_nodes()", vbExclamation Resume ExitFunc End Function Public Function AnglesAreClose(ByRef Angle_A As Double, ByRef Angle_B As Double, ByRef Tolerance As Double) As Boolean 'MsgBox ("ang A : " & Angle_A & " ang B: " & Angle_B & " menos: " & Abs(Angle_A - Angle_B)) If Abs(Angle_A - Angle_B) < Tolerance And Abs(Angle_A - Angle_B) > 79 Then AnglesAreClose = True Else If (Angle_A >= 0 And Angle_A <= Tolerance) And (Angle_B <= 360 And Angle_B >= 360 - Tolerance) Then If Angle_A + (360 - Angle_B) < Tolerance Then AnglesAreClose = True End If Else If (Angle_A <= 360 And Angle_A >= 360 - Tolerance) And (Angle_B >= 0 And Angle_B <= Tolerance) Then If (360 - Angle_A) + Angle_B < Tolerance Then AnglesAreClose = True End If End If End If End If End Function