Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Inventor VBA
  Punkt auf selektierter Fläche finden und Text plazieren

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
Autor Thema:  Punkt auf selektierter Fläche finden und Text plazieren (189 mal gelesen)
Frank_Schalla
Ehrenmitglied
CAD_SYSTEMBETREUER


Sehen Sie sich das Profil von Frank_Schalla an!   Senden Sie eine Private Message an Frank_Schalla  Schreiben Sie einen Gästebucheintrag für Frank_Schalla

Beiträge: 1731
Registriert: 06.04.2002

DELL M6800
Cad Admin
Methodikentwickler 3D

erstellt am: 18. Nov. 2022 15:05    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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



Mitarbeiter für die Arbeitsvorbereitung (m/w/d)

Die Firma abopart ist einer der führenden Hersteller von mobilen Trennwänden in Deutschland. Sie beschäftigt ca. 80 Mitarbeiter am Standort Bad Zwischenahn bei Oldenburg (Oldb.). Der Einsatzbereich von Mobilwänden ist überall dort sinnvoll, wo flexible Raumlösungen benötigt werden wie z.B. in Hotels, Gemeindehäusern, Mehrzweckhallen, Kirchen, Casinos, Industriegebäuden, Versammlungs- und Besprechungsräumen....

Anzeige ansehenFertigung, Produktion
rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik




Sehen Sie sich das Profil von rkauskh an!   Senden Sie eine Private Message an rkauskh  Schreiben Sie einen Gästebucheintrag für rkauskh

Beiträge: 2166
Registriert: 15.11.2006

Windows 10 x64, AIP 2022

erstellt am: 18. Nov. 2022 23:35    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Frank_Schalla 10 Unities + Antwort hilfreich

Hallo

Vermutlich aus einem größeren Skript herauskopiert?
Keine Ahnung ob ich es richtig verstanden habe.

Code:

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
    SK_FOUND = False
   
    Dim oPosition As Point2d
    Set oPosition = ThisApplication.TransientGeometry.CreatePoint2d(10, 20)
   
    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 SetText(planarEntity, sk, "??")
        'Call sk.TextBoxes.AddFitted(oPosition, "??")
    End If
   
End Sub
 
Public Sub SetText(ByVal oFace As Face, ByVal oSketch As Sketch, ByVal itemNo As String)
    'trying to choose an appropriate point
    'assume this planar face has one edge loop only
    Set oEdgeLoop = oFace.EdgeLoops(1)
         
    Set oMinPt = oEdgeLoop.RangeBox.MinPoint
    Set oMaxPt = oEdgeLoop.RangeBox.MaxPoint
         
    Set 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)
    Set oTextPt = oSketch.ModelToSketchSpace(CenterPt)
         
    'add the textbox
    'oSketchText = oSketch.TextBoxes.AddFitted(oTextPt, "MY TEST")
    Set oSketchText = oSketch.TextBoxes.AddFitted(oTextPt, itemNo)
   
End Sub


------------------
MfG
Ralf

RKW Solutions GmbH
www.RKW-Solutions.com

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz