Hallo,
einen API-Befehl gibt's dafür nicht, allerdings kann man sich mit folgendem Workaround behelfen:
1. ) Man erstellt mit einem Makro zunächst eine "tote" Kurve. Wie die aussieht ist dabei völlig nebensächlich, hauptsache man bekommt ein Feature "Curve".
2.) Diese "tote" Curve bekommt dann eine Formel zugewiesen, welche den ISO-Parameter über da Wireframe-Feature "isoparamcurve" generiert.
Anbei ein Code-Beispiel wie so was aussehen könnte:
Die Funktion CreateISOCurve benötigt als Input eine Fläche, einen Punkt an dem der ISO-Parameter generiert werden soll und eine Linie welche die Richtung für das jeweilige u oder v darstellt.
Function CreateISOCurve(iSurface, _
iPoint, _
iDir, _
iHybridBody) As Object
'Strukturpfade generieren (Erstellt den Strukturpfad für den Eintrag in die Formel)
Dim strSurfacePath As String: strSurfacePath = GetAbsoluteHSFeaturePath(iSurface)
Dim strPointPath As String: strPointPath = GetAbsoluteHSFeaturePath(iPoint)
Dim strDirPath As String: strDirPath = GetAbsoluteHSFeaturePath(iDir)
'Dummy-Kurve erzeugen (z.B. Linie zwischen 2 Punkten)
Dim oP1 As HybridShapePointCoord
Dim oP2 As HybridShapePointCoord
Dim oHSF As HybridShapeFactory
Set oHSF = oPart.HybridShapeFactory
Set oP1 = oHSF.AddNewPointCoord(0, 0, 0)
Set oP2 = oHSF.AddNewPointCoord(10, 0, 0)
oP1.Compute
oP2.Compute
Dim oC1 As HybridShapeLinePtPt
Set oC1 = oHSF.AddNewLinePtPt(oPart.CreateReferenceFromObject(oP1), oPart.CreateReferenceFromObject(oP2))
oC1.Compute
'"Tote" Kurve generieren
Dim oCurveExplicit
Set oCurveExplicit = oHSF.AddNewCurveDatum(oPart.CreateReferenceFromObject(oC1))
oCurveExplicit.Compute
iHybridBody.AppendHybridShape oCurveExplicit
oPart.Update
'ISOParameter erzeugen
Dim oRelations As Relations
Set oRelations = oPart.Relations
Dim oRel_ISOParamCurve As Formula
Set oRel_ISOParamCurve = oRelations.CreateFormula("ISOCurve", "", oCurveExplicit, "isoparamcurve(" & strSurfacePath & ", " & strPointPath & ", " & strDirPath & ")")
oPart.Update
'Kurvenobjekt zurückgeben
Set CreateISOCurve = oCurveExplicit
End Function
Function GetAbsoluteHSFeaturePath(iFeature) As String
'Funktion ermittelt rekursiv den Pfad eines Features.
GetAbsoluteHSFeaturePath = ""
Dim strParentPath As String
strParentPath = ""
Dim oParent
Set oParent = iFeature
strParentPath = oParent.Name
Do
Set oParent = oParent.Parent
If TypeName(oParent) = "Part" Then Exit Do
If oParent.Name <> "HybridShapes" And oParent.Name <> "HybridBodies" Then
strParentPath = oParent.Name & "\" & strParentPath
End If
Loop
If InStr(1, strParentPath, " ") <> 0 Then
strParentPath = "`" & strParentPath & "`"
End If
GetAbsoluteHSFeaturePath = strParentPath
End Function
Gruß,
Patrick
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP