Hallo liebe CAD.de community,
ich habe folgendes Problem bei dem unten stehenden Makro. Ich möchte Punkte auf einer Kurve erzeugen, jedoch wird bei der Schleife (siehe unten), die mir durch die Angabe der Anzahl der Punkte kein Ende gesetzt. Der Loop läuft weiter, trotz das die Bedingung zur Beendigung erfüllt wird. Ich weiss leider nicht mehr weiter.
'-------------------------------------------------------------------------------
' Makro zum Erzeugen von Punkten auf einer Linie/Kurve
' Voraussetzung ist, das ein Part geöffnet ist und ein offener Körper mit dem Namen "Punkte" existiert.
Sub CATMain ()
Dim partDocument1 As Document
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As Part
Set part1 = partDocument1.Part
Dim hybridShapeFactory1 As Factory
Set hybridShapeFactory1 = part1.HybridShapeFactory
Dim HB as HybridBody
Set HB = part1.HybridBodies.Item ("Punkte")
' Auswahl festlegen -----------------------------------------------
Dim Was(0)
Was(0) = "HybridShape"
' Selektion definieren und leeren ---------------------------------
Dim UserSel As Selection
Set UserSel= CATIA.ActiveDocument.Selection
UserSel.Clear
' Selektion vornehmen lassen --------------------------------------
Dim E As CATBSTR
E = UserSel.SelectElement2(Was, "Bitte Linie auswählen!", true)
If E = "Normal" Then
MsgBox(UserSel.Item(1).Value.Name & " wurde ausgewählt!")
Else
MsgBox ("Abbruch")
End If
Dim Ref as Reference
Set Ref = part1.CreateReferenceFromObject(UserSel.Item(1).Value)
'Messen der Kurvenlaenge ------------------------------------------
Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench") '--- SPAWorkbench anziehen
Set TheMeasurable = TheSPAWorkbench.GetMeasurable(Ref)
On Error Resume Next
Err.Number = 0
dLength = TheMeasurable.Length
If Err.Number = 0 Then
msgbox " The Length of " & UserSel.Item(1).Value.Name & " is " & dLength & " mm ! " , 64, "Measurement"
Else
msgbox "The Selected Element is not a Curve ! " & VbLf & "No Output !", 48, "Error in Selection"
End If
' Selektion freigeben --------------------------------------------
' UserSel.EndSelectElement
UserSel.Clear
' Eingabe -----------------------------------------------------------
Dim Anzahl
Anzahl = inputbox("Bitte Anzahl Punkte auf Kurve angeben!")
Dim Abstand
Abstand = dlength/(Anzahl+1)
' Schleife fuer Elemente: Punkt, Ebene, Kreis und Flaeche---------------------------
Dim i
i=1
AbstandAnzahl=Abstand
MsgBox ("Anzahl ist" & Anzahl)
MsgBox ("Abstand ist" & AbstandAnzahl)
' Fehler ab hier ?!
Do 'While (i<=Anzahl)
Dim PunktaufLinie
Set PunktaufLinie = hybridShapeFactory1.AddNewPointOnCurveFromDistance(Ref,AbstandAnzahl,true)
HB.AppendHybridShape PunktaufLinie
i = i+1
MsgBox ("Zahl i ist" & i)
MsgBox ("Anzahl ist" & Anzahl)
AbstandAnzahl=Abstand*i
'if i>Anzahl Then Exit Do
'if i>10 Then Exit Do
Loop Until (i>Anzahl) 'Anzahl wird hier nicht erkannt, die Schleife geht weiter?!
part1.Update
End Sub
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP