Hmm stehe wieder mal auf dem Schaluch
Ich möchte nur auf der 2ten Selektion einen Text plazieren
Public partDoc As PartDocument
Public Sub skweld()
Set partDoc = ThisApplication.ActiveDocument
Dim oSketchCheck As PlanarSketch
Dim planarEntity As Object
Dim sk As Sketch
Dim SK_FOUND As Boolean
Dim oPosition As Point2d
Set oPosition = ThisApplication.TransientGeometry.CreatePoint2d(10, 20)
SK_FOUND = False
For Each oSketchCheck In partDoc.ComponentDefinition.Sketches
If oSketchCheck.Name = "VZ_WELDS" Then
SK_FOUND = True
oSketchCheck.Edit
Set planarEntity = ThisApplication.CommandManager.Pick(kAllPlanarEntities, "Select Text location.")
oSketchText = sk.TextBoxes.AddFitted(oPosition, "MY TEST")
Else
End If
Next
If SK_FOUND = True Then
Else
Set planarEntity = ThisApplication.CommandManager.Pick(kAllPlanarEntities, "Select face of Panel A.")
' Add New Sketch
Set sk = partDoc.ComponentDefinition.Sketches.Add(planarEntity)
sk.Name = "VZ_WELDS"
sk.Edit
Set planarEntity = ThisApplication.CommandManager.Pick(kAllPlanarEntities, "Select Text location.")
Call sk.TextBoxes.AddFitted(oPosition, "??")
End If
End Sub
Public Sub SetText()
'trying to choose an appropriate point
'assume this planar face has one edge loop only
oEdgeLoop = oFace.EdgeLoops(1)
oMinPt = oEdgeLoop.RangeBox.MinPoint
oMaxPt = oEdgeLoop.RangeBox.MaxPoint
CenterPt = ThisApplication.TransientGeometry.CreatePoint((oMaxPt.X + oMinPt.X) / 2#, (oMaxPt.Y + oMinPt.Y) / 2#, (oMaxPt.Z + oMinPt.Z) / 2#)
'get one point on the face and transform to the point2d on the sketch
'Set oTextPt = oSketch.ModelToSketchSpace(oPlanarSurface.RootPoint)
oTextPt = oSketch.ModelToSketchSpace(CenterPt)
'add the textbox
'oSketchText = oSketch.TextBoxes.AddFitted(oTextPt, "MY TEST")
oSketchText = oSketch.TextBoxes.AddFitted(oTextPt, itemNo)
End Sub
------------------
************************************
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP