| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte | | | | PNY wird von NVIDIA zum Händler des Jahres gewählt – zum dritten Mal in Folge, eine Pressemitteilung
|
Autor
|
Thema: Prüfmaße, Inventor (2240 / mal gelesen)
|
insidERR Mitglied 2/3D Konstruktion, VBA/.net/Android/Arduino Programmierung, EDV
Beiträge: 138 Registriert: 27.08.2007
|
erstellt am: 25. Sep. 2017 16:16 <-- editieren / zitieren --> Unities abgeben:
Hallo Leute, ich versuche momentan in AutoCAD und Inventor eine Prüfmaßeexportfunktion zu erstellen. In AutoCAD läuft es schon sehr gut. Das Makro durchläuft alle Maße und wenn es ein Prüfmaß ist, wird daraus der Text inkl. Passungen und ober/untertolleranzen extrahiert. Danach wird es an Excel übergeben, wo alles auf einem Formular landet. Siehe Screenshot der extrahiere Daten. Jetzt will ich das gleiche auch noch in Inventor erstellen. Pos.Nr., Textvorsatz, Art(Ø, R oder Winkel), Bemaßungswert, Passung, ob.Toleranz, unt.Toleranz Ich kann im Inventor an die Eigenschaften der einzelnen Bemaßungen kommen, nur ist es etwas unglücklich gemacht. Z.B. der Wert von "FormatedText" ist "Flansch <DimensionValue/>" und bei "Text" steht "Flansch n200" wobei das "n" füt das Durchmesserzeichen steht. Gibt es eine Möglichkeit mit der ich den Wert von "<DimensionValue/>" abfragen kann? Eventuel auch noch um welche Art von Bemaßung es sich handelt. Radius, Durchmesser, Winkel oder Linie. ICh bräuchte alle Werte getrennt von einander. [Diese Nachricht wurde von insidERR am 25. Sep. 2017 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
RolandD Mitglied
Beiträge: 558 Registriert: 07.01.2005 i7-9700k 32GB DDR4-RAM Nvidia RTX 2060 SSD 970 m.2 Win10-64 (21H2) AIP 2020.3 Dell U3417W
|
erstellt am: 26. Sep. 2017 10:36 <-- editieren / zitieren --> Unities abgeben: Nur für insidERR
Hallo, am Besten, du setzt einen Haltepunkt in VBA und schaust dir die Struktur an. Wert von "<DimensionValue/>" abfragen kann?
Code: ThisApplication.ActiveDocument.Sheets.Item(1).DrawingDimensions.Item(1).ModelValue
ist intern in cm. Somit *10 nehmen Art von Bemaßung es sich handelt. Radius, Durchmesser, Winkel oder Linie:
Code: ThisApplication.ActiveDocument.Sheets.Item(1).DrawingDimensions.Item(1).type kDiameterGeneralDimensionObject = Duchmesser kOrdinateDimensionObject = Koordinatenbemassung
------------------ Gruß Roland Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
insidERR Mitglied 2/3D Konstruktion, VBA/.net/Android/Arduino Programmierung, EDV
Beiträge: 138 Registriert: 27.08.2007
|
erstellt am: 27. Sep. 2017 09:22 <-- editieren / zitieren --> Unities abgeben:
Hallo Roland, danke für deinen Beitrag. Hatte die Werte schon entdeckt. War nur nicht sicher, ob man ModelValue immer *10 nehmen kann, oder der Skallierfaktor sich ändern kann. Dachte, es gibt vielleicht eine bessere Lösung. Nun gut. Nach 2 Tagen Fummelei habe ich folgenden Code gebastelt, der genau das ausgibt was ich brauche. Code:
Public Function getPrüfmaße(Optional AutoNummerierung As Boolean, Optional MsgBoxAusgabe As Boolean) As String 'alle Prüfmaße ermitteln 18.09.2017 Dim oDrawDoc As DrawingDocument, dimText As String Dim Shape As InspectionDimensionShapeEnum, PrüfBezeichnung As String, PrüfRate As String Dim tmpText As String, tmpIndex As Single: tmpIndex = 1 Dim Pos As String, Vorsatz As String, Art As String, Wert As String, Passung As String, ObTol As String, UntTol As String Set oDrawDoc = ThisApplication.ActiveDocument For i = 1 To oDrawDoc.ActiveSheet.DrawingDimensions.Count 'alle Bemaßungen durchlaufen If oDrawDoc.ActiveSheet.DrawingDimensions(i).IsInspectionDimension = True Then 'wenn Bemaßung = Prüfbemaßung dann... Pos = "": Vorsatz = "": Art = "": Wert = "": Passung = "": ObTol = "": UntTol = "" 'Variablen leeren '### wennn Autonummerierung erwünscht, dann Wert für Prüfbezeichnung setzen If AutoNummerierung = True Then Call oDrawDoc.ActiveSheet.DrawingDimensions(i).SetInspectionDimensionData(kRoundedEndsInspectionBorder, tmpIndex): tmpIndex = tmpIndex + 1 '### Eigenschaften der "Prüfbemaßung" (Form, Pos) auslesen Call oDrawDoc.ActiveSheet.DrawingDimensions(i).GetInspectionDimensionData(Shape, Pos, PrüfRate) '### wenn "Form" <> "rund" dann auf "rund" setzen If Shape <> kRoundedEndsInspectionBorder Then Call oDrawDoc.ActiveSheet.DrawingDimensions(i).SetInspectionDimensionData(kRoundedEndsInspectionBorder, "", "") '### angezeigten Text temporär merken tmpText = oDrawDoc.ActiveSheet.DrawingDimensions(i).Text.Text '### Text vor dem Bemaßungswert Vorsatz = Left(oDrawDoc.ActiveSheet.DrawingDimensions(i).Text.FormattedText, InStr(1, oDrawDoc.ActiveSheet.DrawingDimensions(i).Text.FormattedText, "<") - 1) '### Bemaßungswert Wert = FormatNumber(oDrawDoc.ActiveSheet.DrawingDimensions(i).ModelValue * 10, oDrawDoc.ActiveSheet.DrawingDimensions(i).Precision): _ If Right(Wert, 2) = ",0" Then Wert = Left(Wert, Len(Wert) - 2) '### Durchmesser If InStr(1, tmpText, "n" & Wert) <> 0 And Art = "" Then Art = "Ø" '### Radius If InStr(1, tmpText, "R" & Wert) <> 0 And Art = "" Then Art = "R" '### Winkelbemaßung If oDrawDoc.ActiveSheet.DrawingDimensions(i).Type = kAngularGeneralDimensionObject Then _ Art = "W": Wert = FormatNumber(oDrawDoc.ActiveSheet.DrawingDimensions(i).ModelValue * 57.2957795130824, oDrawDoc.ActiveSheet.DrawingDimensions(i).Precision): _ If Right(Wert, 2) = ",0" Then Wert = Left(Wert, Len(Wert) - 2) '### Passungen auslesen If oDrawDoc.ActiveSheet.DrawingDimensions(i).Tolerance.HoleTolerance <> "" Then Passung = oDrawDoc.ActiveSheet.DrawingDimensions(i).Tolerance.HoleTolerance If oDrawDoc.ActiveSheet.DrawingDimensions(i).Tolerance.ShaftTolerance <> "" Then Passung = oDrawDoc.ActiveSheet.DrawingDimensions(i).Tolerance.ShaftTolerance If oDrawDoc.ActiveSheet.DrawingDimensions(i).Tolerance.ShaftTolerance <> "" And oDrawDoc.ActiveSheet.DrawingDimensions(i).Tolerance.HoleTolerance <> "" Then _ Passung = oDrawDoc.ActiveSheet.DrawingDimensions(i).Tolerance.HoleTolerance & "/" & oDrawDoc.ActiveSheet.DrawingDimensions(i).Tolerance.ShaftTolerance '### Tolleranzen auslesen If oDrawDoc.ActiveSheet.DrawingDimensions(i).Tolerance.Upper <> 0 Then ObTol = FormatNumber(oDrawDoc.ActiveSheet.DrawingDimensions(i).Tolerance.Upper * 10, oDrawDoc.ActiveSheet.DrawingDimensions(i).TolerancePrecision) If oDrawDoc.ActiveSheet.DrawingDimensions(i).Tolerance.Lower <> 0 Then UntTol = FormatNumber(oDrawDoc.ActiveSheet.DrawingDimensions(i).Tolerance.Lower * 10, oDrawDoc.ActiveSheet.DrawingDimensions(i).TolerancePrecision) If oDrawDoc.ActiveSheet.DrawingDimensions(i).Tolerance.ToleranceType = kSymmetricTolerance Then UntTol = ObTol * -1 '### neue Werte merken dimText = dimText & Pos & vbTab & Vorsatz & vbTab & Art & vbTab & Wert & vbTab & Passung & vbTab & ObTol & vbTab & UntTol & vbNewLine End If Next i '### Rückgabewert getPrüfmaße = dimText '### wenn MsgBoxAusgabe erwünscht dann If MsgBoxAusgabe = True Then MsgBox "Pos." & vbTab & "Vorsatz" & vbTab & "Art" & vbTab & "Wert" & vbTab & "Passung" & vbTab & "Ob.Tol" & vbTab & "Unt.Tol" & vbNewLine & dimText End Function
Falls einer den Code hier gebrauchen kann, wären ein kurzer Kommentar hier willkommen :-) [Diese Nachricht wurde von insidERR am 27. Sep. 2017 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|