| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
| |
| Request a special discount on NVIDIA RTX 5000 Ada Generation GPU !, eine Pressemitteilung
|
Autor
|
Thema: Aktiven Bemaßungsstil ändern (1821 / mal gelesen)
|
tanzy Mitglied
Beiträge: 32 Registriert: 02.10.2017 Inventor 2018
|
erstellt am: 29. Jan. 2018 07:42 <-- editieren / zitieren --> Unities abgeben:
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
Beiträge: 32 Registriert: 02.10.2017 Inventor 2018
|
erstellt am: 29. Jan. 2018 12:57 <-- editieren / zitieren --> Unities abgeben:
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
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 / zitieren --> Unities abgeben: Nur für tanzy
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
Beiträge: 32 Registriert: 02.10.2017 Inventor 2018
|
erstellt am: 29. Jan. 2018 13:47 <-- editieren / zitieren --> Unities abgeben:
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
Beiträge: 172 Registriert: 16.01.2014
|
erstellt am: 30. Jan. 2018 14:14 <-- editieren / zitieren --> Unities abgeben: Nur für tanzy
|