Fehlerhafte Knoten-Griffe automatisch finden

[koter]

hallo Asterix,

...Entweder ich finde heraus, wo diese Griffe sind, die so winzig sind, oder ich finde die verkehrten Dreiecke...

der folgende Code markiert Steuerpunkte die kürzer sind als die Linienbreite:

Code:

Sub kurzeSteuerpunkteMarkieren()
   Dim s As Shape
   Dim c As Curve
   Dim sp As SubPath
   Dim sgF As Segment, sgL As Segment
   Dim minL As Double
   ActiveDocument.Unit = cdrMillimeter
   
   For Each s In ActiveLayer.Shapes
       minL = s.Outline.Width
       Set c = s.Curve
       For Each sp In c.SubPaths
           Set sgF = sp.Segments.First
           Set sgL = sp.Segments.Last
           If sgF.StartingControlPointLength < minL Then Markierung sgF.StartingControlPointX, sgF.StartingControlPointY, True
           If sgL.EndingControlPointLength < minL Then Markierung sgL.EndingControlPointX, sgL.EndingControlPointY
       Next
   Next
End Sub

Sub Markierung(x As Double, y As Double, Optional red As Boolean = False)
   Dim s As Shape
   Dim L As Layer, LA As Layer
   Set LA = ActiveLayer
   If LayerExists("Steuerpunktmarkierung") Then
       Set L = ActivePage.Layers("Steuerpunktmarkierung")
   Else
       Set L = ActivePage.CreateLayer("Steuerpunktmarkierung")
   End If
   Set s = L.CreateEllipse2(x, y, 1)
   If red Then
       s.Outline.Color.RGBAssign 255, 0, 0
   Else
       s.Outline.Color.RGBAssign 0, 100, 0
   End If
   s.Outline.Width = 0.1
   LA.Activate
End Sub

Public Function LayerExists(ByVal strLayerName As String) As Boolean
   Dim objLayer As Layer
   On Error Resume Next
   Set objLayer = ActivePage.Layers(strLayerName)
   LayerExists = Not objLayer Is Nothing
End Function

Ich weiß nicht ob es mit Deiner Version funktioniert, und ob es Dir überhaupt hilft.

Gruß

Koter