Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Inventor VBA
  Aktiven Bemaßungsstil ändern

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:  Aktiven Bemaßungsstil ändern (1691 mal gelesen)
tanzy
Mitglied



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

Beiträge: 32
Registriert: 02.10.2017

Inventor 2018

erstellt am: 29. Jan. 2018 07:42    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

Hallo an alle!

Ich benutze folgenden Code um das "Bemaßung" Werkzeug zu aktivieren und den gewünschten Bemaßungsstil zu suchen.. allerdings Bin ich nicht im Stande den gewünschten Stil dann auch als aktiven Stil zu setzen. Alles was ich tun möchte ist den Befehl "Bemaßung" aktivieren und dann gleich auf einen gewissen Stil setzen sodass auch mit dem Stil bemaßt wird.

Kann mir dabei jemand bitte helfen?

Danke!

Code:

Public Sub RunLineCommand()
    ' Get the CommandManager object.
    Dim oCommandMgr As CommandManager
    oCommandMgr = ThisApplication.CommandManager

    ' Get control definition for the line command.
    Dim oControlDef As ControlDefinition
    oControlDef = oCommandMgr.ControlDefinitions.Item("DrawingGeneralDimensionCmd") 
    ' Execute the command.
    Call oControlDef.Execute

 

Dim doc As DrawingDocument
doc = ThisApplication.ActiveDocument


        ????????? = doc.StylesManager.DimensionStyles(2)

End Sub


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

tanzy
Mitglied



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

Beiträge: 32
Registriert: 02.10.2017

Inventor 2018

erstellt am: 29. Jan. 2018 12:57    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


2018-01-29_12h49_24.png

 
Nur um zu erklären was ich bräuchte:

Ich müsste die markierte Einstellung über VBA oder iLogic ändern nachdem ich den befehl Bemaßung über VBA aktiviert habe. (Ist bereits gemacht.. Fehlt nur noch die Aktivierung des Stils.)

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

Tacker
Mitglied
TZ, Tech. MB, Softwareentwickler


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

Beiträge: 175
Registriert: 23.09.2010

IV 2017 Pro
i7-7700K 4x4.2GHz
32GB DDR4-2400
GTX 1060 6GB DDR5

erstellt am: 29. Jan. 2018 13:38    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 tanzy 10 Unities + Antwort hilfreich

Moin ,

Das wird mit dem Befehl so nie funktionieren.
Das hat den Grund dass DrawingGeneralDimensionCmd.Execute keinen Rückgabewert hat, ergo wartet VBA auch nicht auf Beendigung des Befehls und du bekommst keine Objekte zurück die du weiter verwenden könntest.

Als Vorschlag kann ich dir folgendes liefern:

Das hier in ein Modul kopieren:

Code:

Public Sub TestSelection()

Dim oDrawDoc As Inventor.DrawingDocument
If ThisApplication.ActiveDocument.DocumentType = kDrawingDocumentObject Then
    Set oDrawDoc = ThisApplication.ActiveDocument
Else
    'Meldung erforderlich?
    Exit Sub
End If

'Start Selektion
    Dim selEdge1 As DrawingCurveSegment
    Dim selEdge2 As DrawingCurveSegment
    Set selEdge1 = ThisApplication.CommandManager.Pick(kDrawingCurveSegmentFilter, "Select DrawingCurve-1.")
    Set selEdge2 = ThisApplication.CommandManager.Pick(kDrawingCurveSegmentFilter, "Select DrawingCurve-2.")

    Dim oSheet As Sheet
    Set oSheet = oDrawDoc.ActiveSheet
   
    Dim oIntent1 As GeometryIntent
    Set oIntent1 = oSheet.CreateGeometryIntent(selEdge1.Parent)
       
    Dim oIntent2 As GeometryIntent
    Set oIntent2 = oSheet.CreateGeometryIntent(selEdge2.Parent)

    Dim oPt As Point2d
    Set oPt = TestGetDrawingPoint

    Dim oLinDim As LinearGeneralDimension
    Set oLinDim = oSheet.DrawingDimensions.GeneralDimensions.AddLinear(oPt, oIntent1, oIntent2)
    'oLinDim Stil hier anpassen
End Sub

Public Function TestGetDrawingPoint() As Point2d
    Dim getPoint As New clsGetPoint
    Dim pnt As Point2d
   
    Do
        Set pnt = getPoint.GetDrawingPoint("Click the desired location", kLeftMouseButton)
        If Not pnt Is Nothing Then
            Set TestGetDrawingPoint = pnt
            Exit Function
            'MsgBox "Click is at " & Format(pnt.x, "0.0000") & ", " & Format(pnt.Y, "0.0000")
        End If
    Loop While Not pnt Is Nothing
End Function


Das hier in ein neues Klassenmodul kopieren und "clsGetPoint" nennen:

Code:

Private WithEvents m_interaction As InteractionEvents
Private WithEvents m_mouse As MouseEvents
Private m_position As Point2d
Private m_button As MouseButtonEnum
Private m_continue As Boolean


Public Function GetDrawingPoint(Prompt As String, button As MouseButtonEnum) As Point2d
    Set m_position = Nothing
    m_button = button
   
    Set m_interaction = ThisApplication.CommandManager.CreateInteractionEvents
    Set m_mouse = m_interaction.MouseEvents
   
    m_interaction.StatusBarText = Prompt
   
    m_interaction.Start
   
    m_continue = True
    Do
        DoEvents
    Loop While m_continue
   
    m_interaction.Stop
   
    Set GetDrawingPoint = m_position
End Function


Private Sub m_mouse_OnMouseClick(ByVal button As MouseButtonEnum, ByVal ShiftKeys As ShiftStateEnum, ByVal ModelPosition As Point, ByVal ViewPosition As Point2d, ByVal View As View)
    If button = m_button Then
        Set m_position = ThisApplication.TransientGeometry.CreatePoint2d(ModelPosition.x, ModelPosition.y)
    End If
   
    m_continue = False
End Sub


Das ganze ist zusammengebastelt auf die Schnelle und ich benutze das Makro selbst nicht, ergo keine Erfahrung damit und es kann zu Fehlern kommen. Um die Fehlervermeidung wirst dich selbst kümmern müssen.


Der Code um den Point on Sheet zu bekommen stammt von hier:
https://forums.autodesk.com/t5/inventor-customization/selecting-a-point2d-with-your-mouse-on-a-drawing-sheet/td-p/3739407

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

tanzy
Mitglied



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

Beiträge: 32
Registriert: 02.10.2017

Inventor 2018

erstellt am: 29. Jan. 2018 13:47    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

Hallo,

Sorry bin aber ein Neuling und habe nicht so ganz verstanden wieso das nicht geht. Ist es nicht möglich einfach aus dem Dropdown einen anderen Stil zu aktivierne über VBA? das ist im Grunde alles was ich brauchen würde.. wäre auch ok wenn das über einem Hack gehen würde wie zB. "alt - A - ST - Pfeil nach unten" als keypress zu simulieren..

Danke!

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

BernoAn
Mitglied



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

Beiträge: 164
Registriert: 16.01.2014

erstellt am: 30. Jan. 2018 14:14    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 tanzy 10 Unities + Antwort hilfreich

Dann würde das so funtkionieren

  SendKeys "%"
  SendKeys "a"
  SendKeys "st"
  SendKeys "{Down}"
  SendKeys "{Down}"
  SendKeys "{ENTER}"

Gruß
Berno

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