Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de (alle Foren)
  Inventor
  Positionsnummer anpassen

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

Anzeige:

Thema geschlossen  Thema geschlossen!
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
  
Die Ähnlichkeit zu Productstream Professional ist bemerkenswert. (GAIN Collaboration,PDM,PDM System,PLM,PLM System)
Autor Thema:  Positionsnummer anpassen (916 mal gelesen)
CAD Kalle
Mitglied
Maschinenbauingenieur


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

Beiträge: 59
Registriert: 29.07.2017

Intel Core I5, AMD Radeon HD 6800 32GB Ram, Windows 10 64 bit, Inventor 2017

erstellt am: 31. Jul. 2017 18:48    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

Guten Tag zusammen,:

Ich bin neu in diesem Forum und habe eine Frage zu Thema Positionsnummern anpassen mit VBA.  

Aber erst einmal zu mir : Ich bin Maschinenbauingenieur und arbeite seit 25 Jahren in der Automobilbranche
vorwiegend mit Catia V5 und NX. Mit VBA kenne ich mich nur wenig aus was Inventor betrifft.

Seit einiger Zeit haben wir ein Tochterunternehmen gekauft und ich soll jetzt
deren CAD System an unseres anpassen. Was natürlich nur begrenzt geht. Genau genommen sollen die DWG die aus Inventor kommen
von der Optik denen von Catia u. NX gleichen. Zum  Teil konnte ich das über die Stilbibliothek anpassen, aber nur zum Teil.
Die Geschäftführung möchte gerne die Positionsnummer in etwa so habe; Positionsnummer dann als zweite Zeile die Bezeichnung und so weiter.
Jetzt werden einige von euch sagen das geht mit Bortmitteln ok, aber die zweite und dritte Zeilen sollen einen andern Schriftstil und Schriftgröße haben.
Ich habe dazu eine Vba code snippet in der API-Hilfe gefunden. Komme aber nicht an den Schriftstil ran.
Könnte mir jemand von euch einen Tipp geben wie ich an den Schriftstil und Größe kommen um diese anzupassen?

Hier mein erster: Ansatz: wohl bemerkt er ist aus der API Hilfe

Public Sub CreateBalloon()
    ' Set a reference to the drawing document.
    ' This assumes a drawing document is active.
    Dim oDrawDoc As DrawingDocument
    Set oDrawDoc = ThisApplication.ActiveDocument

    ' Set a reference to the active sheet.
    Dim oActiveSheet As Sheet
    Set oActiveSheet = oDrawDoc.ActiveSheet

    ' Set a reference to the drawing curve segment.
    ' This assumes that a drwaing curve is selected.
    Dim oDrawingCurveSegment As DrawingCurveSegment
    Set oDrawingCurveSegment = oDrawDoc.SelectSet.Item(1)

    ' Set a reference to the drawing curve.
    Dim oDrawingCurve As DrawingCurve
    Set oDrawingCurve = oDrawingCurveSegment.Parent

    ' Get the mid point of the selected curve
    ' assuming that the selection curve is linear
    Dim oMidPoint As Point2d
    Set oMidPoint = oDrawingCurve.MidPoint

    ' Set a reference to the TransientGeometry object.
    Dim oTG As TransientGeometry
    Set oTG = ThisApplication.TransientGeometry

    Dim oLeaderPoints As ObjectCollection
    Set oLeaderPoints = ThisApplication.TransientObjects.CreateObjectCollection

    ' Create a couple of leader points.
    Call oLeaderPoints.Add(oTG.CreatePoint2d(oMidPoint.X + 10, oMidPoint.Y + 10))
    Call oLeaderPoints.Add(oTG.CreatePoint2d(oMidPoint.X + 10, oMidPoint.Y + 5))

    ' Add the GeometryIntent to the leader points collection.
    ' This is the geometry that the balloon will attach to.
    Dim oGeometryIntent As GeometryIntent
    Set oGeometryIntent = oActiveSheet.CreateGeometryIntent(oDrawingCurve)
    Call oLeaderPoints.Add(oGeometryIntent)

    ' Set a reference to the parent drawing view of the selected curve
    Dim oDrawingView As DrawingView
    Set oDrawingView = oDrawingCurve.Parent

    ' Set a reference to the referenced model document
    Dim oModelDoc As Document
    Set oModelDoc = oDrawingView.ReferencedDocumentDescriptor.ReferencedDocument

    ' Check if a partslist or a balloon has already been created for this model
    Dim IsDrawingBOMDefined As Boolean
    IsDrawingBOMDefined = oDrawDoc.DrawingBOMs.IsDrawingBOMDefined(oModelDoc.FullFileName)

    Dim oBalloon As Balloon

    If IsDrawingBOMDefined Then

        ' Just create the balloon with the leader points
        ' All other arguments can be ignored
        Set oBalloon = oDrawDoc.ActiveSheet.Balloons.Add(oLeaderPoints)
    Else

        ' First check if the 'structured' BOM view has been enabled in the model

        ' Set a reference to the model's BOM object
        Dim oBOM As BOM
        Set oBOM = oModelDoc.ComponentDefinition.BOM

        If oBOM.StructuredViewEnabled Then

            ' Level needs to be specified
            ' Numbering options have already been defined
            ' Get the Level ('All levels' or 'First level only')
            ' from the model BOM view - must use the same here
            Dim Level As PartsListLevelEnum
            If oBOM.StructuredViewFirstLevelOnly Then
                Level = kStructured
            Else
                Level = kStructuredAllLevels
            End If

            ' Create the balloon by specifying just the level
            Set oBalloon = oActiveSheet.Balloons.Add(oLeaderPoints, , Level)
        Else

            ' Level and numbering options must be specified
            ' The corresponding model BOM view will automatically be enabled
            Dim oNumberingScheme As NameValueMap
            Set oNumberingScheme = ThisApplication.TransientObjects.CreateNameValueMap

            ' Add the option for a comma delimiter
            oNumberingScheme.Add "Delimiter", ","

            ' Create the balloon by specifying the level and numbering scheme
            Set oBalloon = oActiveSheet.Balloons.Add(oLeaderPoints, , kStructuredAllLevels, oNumberingScheme)
        End If
    End If
End Sub

Bin für jede Hilfe dankbar


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

CAD Kalle
Mitglied
Maschinenbauingenieur


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

Beiträge: 59
Registriert: 29.07.2017

Intel Core I5, AMD Radeon HD 6800 32GB Ram, Windows 10 64 bit, Inventor 2017

erstellt am: 31. Jul. 2017 19:26    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

Sorry habe das falsche Forum gewählt

habe meinen Beitrag schon in VBA Forum gestellt

Entschuldiung

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


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

Administrative Optionen: Beitrag öffnen | Archivieren/Bewegen | Beitrag melden!

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

(c)2024 CAD.de | Impressum | Datenschutz