Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Inventor VBA
  Länge, Breite, Höhe an Iprop übergeben

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:  Länge, Breite, Höhe an Iprop übergeben (3151 mal gelesen)
Didikalle
Mitglied
Konstrukteur


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

Beiträge: 91
Registriert: 07.10.2011

Ich nutze Inventor 2016 mit dem BS Win 10

erstellt am: 24. Mrz. 2015 20:15    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
Ich habe in letzter Zeit viel mit Bleche und Abwicklungen zu tun. Dabei muss ich die Länge und Breite aber auch die Stärke der abgewickelten Blech als "Länge" und "Breite" und "Stärke"an Iprobertie übergeben. Ist das mit VBA möglich auch immer die längste Seite als "Länge" auszugeben (auch wenn die Kante nicht X ist)? Wie muss das Makro aussehen? Schon jetzt besten Danke.

------------------
Didi

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

CADboogie
Mitglied
Dipl.-Ing. Konstrukteur für Luftführungssysteme


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

Beiträge: 241
Registriert: 05.08.2009

Intel Xeon@ 3,07 GHz
NVIDIA Quadro 2000
Windows 7, SP1, 64Bit
Inventor 2012 (SP2), 2014 (SP2)

erstellt am: 25. Mrz. 2015 08:32    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 Didikalle 10 Unities + Antwort hilfreich

Guten morgen,

ist zwar nicht VBA sondern iLogic, dürfte aber auch funktionieren. Ich überprüfe hier nur, auf welches Blechformat (klein, mittel oder groß) die Abwicklungs paßt. Aber hier kannst Du erkennen, dass das größte Maß (Max(...)) als Länge genutzt wird.

Sub Main()
Dim max_form as Double 'die größte der beiden Abmessungen
Dim min_form as Double 'die kleinste der beiden Abmessungen
Dim i_form as Integer 'Kennzahl für das Blechformat: 0=ungültig, 1=klein, 2=mittel, 3=groß
Dim txt_form as String
i_form=0 'vorbesetzen
txt_form="" 'vorbesetzen

InventorVb.DocumentUpdate() 'vor Abfragen der max. Werte Bauteil aktualisieren

min_form =Round(Min( SheetMetal.FlatExtentsLength,SheetMetal.FlatExtentsWidth),0)
max_form=Round(Max( SheetMetal.FlatExtentsLength,SheetMetal.FlatExtentsWidth),0)

i_form=checkform(min_form, max_form)
txt_form=formtxt(i_form)

MessageBox.Show("Abwicklung = " & max_form & " x " & min_form &  vbLf & txt_form , "Info zur Abwicklung")

End Sub

Function checkform(min_form,max_form)
If min_form>1500 Then
i_form=0
Else If min_form>1250 Then
If max_form>3000 Then
i_form=0
Else i_form=3
End If
Else If min_form>1000 Then
If max_form>3000 Then
i_form=0
Else If max_form>2500
i_form=3
Else i_form=2
End If
Else
If max_form>3000 Then
i_form=0
Else If max_form>2500
i_form=3
Else If max_form>2000
i_form=2
Else i_form=1
End If
End If
Return i_form
End Function
Function formtxt(i_form)
Select Case i_form
Case 0
txt_form="Keine gültige Abwicklung!"
Case 1
txt_form="entspricht Kleinformat 2000 x 1000 mm"
Case 2
txt_form="entspricht Mittelformat 2500 x 1250 mm"
Case 3
txt_form="entspricht Großformat 3000 x 1500 mm"
End Select
Return txt_form
End Function

------------------
Gruß aus Aachen,
Walter

*** Man kann nicht alles gleichzeitig machen, aber man kann alles gleichzeitig sein lassen ***

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

Didikalle
Mitglied
Konstrukteur


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

Beiträge: 91
Registriert: 07.10.2011

Ich nutze Inventor 2016 mit dem BS Win 10

erstellt am: 26. Mrz. 2015 10:54    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 Walter
Danke für die Antwort.
Ich habe mir das etwas anders vorgestellt. Da die Abfrage doch häufig vorkommt und ich die Werte Länge, Breite, Stärke zur Weiterverarbeitung in benutzerdefinierte Iproperties benötige, wäre ein Makro mit VBA sinnvoller. Wie schon erwähnt, sollte das auch bei einem Kantprofil mit Blechabwicklung funktionieren.
Ich habe die iLogic-Regel von Dir probiert, sie funktioniert, gibt mir aber nur den Wert LängexBreite wieder.

------------------
Didi

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

Chris 31
Mitglied
Konstrukteur und Mädchen für alles


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

Beiträge: 575
Registriert: 23.04.2013

Inventor 2013/2015
Windows 7 64 bit
16GB RAM
nVidia Quadro 600

erstellt am: 26. Mrz. 2015 12:40    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 Didikalle 10 Unities + Antwort hilfreich

Hallo,

jetzt nur auf die Schnelle hingetippt:

Code:
Public Sub iProps()

Dim Länge1 As Parameter
Dim Länge2 As Parameter
Dim Stärke As Parameter

Set Länge1 = ThisApplication.ActiveDocument.ComponentDefinition.Parameters.Item("*******BreitenParameter********")
Set Länge2 = ThisApplication.ActiveDocument.ComponentDefinition.Parameters.Item("*******LängenParameter********")
Set Stärke = ThisApplication.ActiveDocument.ComponentDefinition.Parameters.Item("*******StärkenParameter********")

Dim UserProps As propertyset
Dim LängeProp As Property
Dim BreiteProp As Property
Dim StärkeProp As Property

Set UserProps = ThisApplication.ActiveDocument.PropertySets.Item("User Defined Properties")
Set LängeProp = UserProps.Item("Länge")
Set BreiteProp = UserProps.Item("Breite")
Set StärkeProp = UserProps.Item("Stärke")

StärkeProp.Expression = Stärke.Value & " mm"

If Länge1.Value < Länge2.Value Then
LängeProp.Expression = Länge2.Value & " mm"
BreiteProp.Expression = Länge1.Value & " mm"
Else
LängeProp.Expression = Länge1.Value & " mm"
BreiteProp.Expression = Länge2.Value & " mm"
End If

ThisApplication.ActiveDocument.Save

End Sub


------------------
MFG

Chris

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

Didikalle
Mitglied
Konstrukteur


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

Beiträge: 91
Registriert: 07.10.2011

Ich nutze Inventor 2016 mit dem BS Win 10

erstellt am: 26. Mrz. 2015 13:58    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 Chris,
danke für Deinen Einsatz. Ich habe das Makro probiert, funktioniert aber leider nicht. Der Debugger verweist auf alle Set-Applicationen.
Wahrscheinlich ist da nur ein kleiner Fehler drin, den ich aber nicht erkenne.
Gruss Didi

------------------
Didi

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

Chris 31
Mitglied
Konstrukteur und Mädchen für alles


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

Beiträge: 575
Registriert: 23.04.2013

Inventor 2013/2015
Windows 7 64 bit
16GB RAM
nVidia Quadro 600

erstellt am: 26. Mrz. 2015 14: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 Nur für Didikalle 10 Unities + Antwort hilfreich

Hallo Didi,

du hast aber schon alle mit "***********" markierten Parameter durch deine ersetzt?
Da sollte dann in etwa sowas stehen :

Code:
Set Länge1= ThisApplication.ActiveDocument.ComponentDefinition.Parameters.Item("d1")

------------------
MFG

Chris

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

CADboogie
Mitglied
Dipl.-Ing. Konstrukteur für Luftführungssysteme


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

Beiträge: 241
Registriert: 05.08.2009

Intel Xeon@ 3,07 GHz
NVIDIA Quadro 2000
Windows 7, SP1, 64Bit
Inventor 2012 (SP2), 2014 (SP2)

erstellt am: 26. Mrz. 2015 15: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 Nur für Didikalle 10 Unities + Antwort hilfreich

Zitat:
Original erstellt von Didikalle:
Hallo Walter

Ich habe die iLogic-Regel von Dir probiert, sie funktioniert, gibt mir aber nur den Wert LängexBreite wieder.


Schon klar, aber Du kannst z. B. mit

oDraw.PropertySets.item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").item("Breite").Value = min_form
oDraw.PropertySets.item("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").item("Länge").Value = max_form

den benutzerdefinirten iProperties die Werte zuweisen. Die min_form und max_form sind Werte aus der Abwicklung, also wirklich das kleinste und größte Maß von Blechzuschnitt.

------------------
Gruß aus Aachen,
Walter

*** Man kann nicht alles gleichzeitig machen, aber man kann alles gleichzeitig sein lassen ***

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

Didikalle
Mitglied
Konstrukteur


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

Beiträge: 91
Registriert: 07.10.2011

Ich nutze Inventor 2016 mit dem BS Win 10

erstellt am: 26. Mrz. 2015 15:45    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 Chris,
sorry. Jetzt habe ich den Code ergänzt und siehe es kommt etwas rüber. Allerdings kommen die Werte in cm-Größe mit mm-Bezeichnung (444mm wird 44,4mm). Ich denke, die .Expression müssen mit 10 multipliziert werden.
Was ich aber nicht so gut finde ist, dass hier auf feste Modellparameter zugegriffen wird. Kann da nicht eine Variable eingebaut werden? Bei Kantprofilen wird eine Abwicklung erstellt, wie kann ich darauf zugreifen?
Gruss Didi

------------------
Didi

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

Chris 31
Mitglied
Konstrukteur und Mädchen für alles


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

Beiträge: 575
Registriert: 23.04.2013

Inventor 2013/2015
Windows 7 64 bit
16GB RAM
nVidia Quadro 600

erstellt am: 26. Mrz. 2015 15:54    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 Didikalle 10 Unities + Antwort hilfreich

Hallo Didi,

ja sorry, das mit dem Umrechnen in mm vergesse ich leider regelmäßig.
Du musst also die iProp.Expression = Parameter.Value *10 setzen.

Du kannst die beiden Parameter Länge und Breite ersetzen durch


 

Code:
Dim max_form as Double
Dim min_form as Double

min_form =Round(Min( SheetMetal.FlatExtentsLength,SheetMetal.FlatExtentsWidth),0)
max_form=Round(Max( SheetMetal.FlatExtentsLength,SheetMetal.FlatExtentsWidth),0)


dann kannst du dir sogar die Abfrage sparen:

Code:

LängeProp.Expression = max_form & " mm"
BreiteProp.Expression = min_form & " mm"

Bei dem Zugriff auf die Abwicklung kann ich dir im Moment leider auch nicht helfen. Damit habe ich noch nie was zu tun gehabt.

------------------
MFG

Chris

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

RolandD
Mitglied



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

Beiträge: 533
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. Mrz. 2015 16:23    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 Didikalle 10 Unities + Antwort hilfreich

Zitat:
Original erstellt von Chris 31:
Bei dem Zugriff auf die Abwicklung kann ich dir im Moment leider auch nicht helfen. Damit habe ich noch nie was zu tun gehabt.


..glaube ich nicht :)
Das sind die Abmessungen der Abwicklung.

Code:
Dim max_form as Double
Dim min_form as Double
min_form = 10 * Round(Min( SheetMetal.FlatExtentsLength,SheetMetal.FlatExtentsWidth),0)
max_form = 10 * Round(Max( SheetMetal.FlatExtentsLength,SheetMetal.FlatExtentsWidth),0)

LängeProp.Expression = max_form & " mm"
BreiteProp.Expression = min_form & " mm"



------------------
Gruß Roland

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

Didikalle
Mitglied
Konstrukteur


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

Beiträge: 91
Registriert: 07.10.2011

Ich nutze Inventor 2016 mit dem BS Win 10

erstellt am: 26. Mrz. 2015 16:36    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 Chris,
ich habe leider einige Probleme mit VBA. Kannst Du mir den kompletten Code mit den Korrekturen zukommen lassen? Schau mal oben, da hat CADboogie ein Zugang zu den Blechabwicklungen, vielleicht kannst Du das auch einbauen. Ich sage jetzt schon Danke für die Mühen.
Gruß Didi

------------------
Didi

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

Chris 31
Mitglied
Konstrukteur und Mädchen für alles


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

Beiträge: 575
Registriert: 23.04.2013

Inventor 2013/2015
Windows 7 64 bit
16GB RAM
nVidia Quadro 600

erstellt am: 27. Mrz. 2015 12:01    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 Didikalle 10 Unities + Antwort hilfreich

Hallo Didi, ich schaue es mir nachher mal an.

Lade es dann hier hoch, sobald ich fertig bin.

------------------
MFG

Chris

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

Didikalle
Mitglied
Konstrukteur


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

Beiträge: 91
Registriert: 07.10.2011

Ich nutze Inventor 2016 mit dem BS Win 10

erstellt am: 27. Mrz. 2015 20:09    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

entschuldige die späte Reaktion, bin gerade wieder zuhause.
Danke für Deinen Einsatz, freue mich schon auf eine Lösung.
Gruß Didi

------------------
Didi

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

Didikalle
Mitglied
Konstrukteur


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

Beiträge: 91
Registriert: 07.10.2011

Ich nutze Inventor 2016 mit dem BS Win 10

erstellt am: 31. Mrz. 2015 11:55    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 Chris,

hast Du schon etwas erreichen können? Ich habe mich auch mal versucht, die in diesem Thread gesammelten Bauteile zusammen zu bringen, allerdings ohne Ergebnis. Da sieht man, dass meine VBA-Kenntnisse nicht ausreichend sind.

LG Didi  

------------------
Didi

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

Didikalle
Mitglied
Konstrukteur


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

Beiträge: 91
Registriert: 07.10.2011

Ich nutze Inventor 2016 mit dem BS Win 10

erstellt am: 31. Mrz. 2015 12:03    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

Ich nochmal,

ich möchte Walther und Roland nicht ausklammern. Euch gilt auch mein Dank. Wenn Ihr Lösungen habt, wäre das auch super.

Gruß Didi

------------------
Didi

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

Chris 31
Mitglied
Konstrukteur und Mädchen für alles


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

Beiträge: 575
Registriert: 23.04.2013

Inventor 2013/2015
Windows 7 64 bit
16GB RAM
nVidia Quadro 600

erstellt am: 31. Mrz. 2015 12:31    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 Didikalle 10 Unities + Antwort hilfreich

Hey, sorry aber ich komme im Moment leider nicht dazu, mich damit zu beschäftigen. Wahrscheinlich kann ich mich erst nach Ostern mal dransetzen.

------------------
MFG

Chris

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

Didikalle
Mitglied
Konstrukteur


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

Beiträge: 91
Registriert: 07.10.2011

Ich nutze Inventor 2016 mit dem BS Win 10

erstellt am: 31. Mrz. 2015 13:03    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

alles klar

Gruß Didi

------------------
Didi

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

Didikalle
Mitglied
Konstrukteur


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

Beiträge: 91
Registriert: 07.10.2011

Ich nutze Inventor 2016 mit dem BS Win 10

erstellt am: 31. Mrz. 2015 19:32    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

Ich habe mich einmal mit der VBA von rkauskh beschäftigt weil diese meinen Wünschen schon sehr nahe kommt. Mit diesem Makro kann man die Länge, Breite und Stärke eines Bauteils oder Blechs an die benutzerdefinierten Ipropertie übergeben. Bei Bauteile markiert man Volumenkörper 1 (findet man unter Volumenkörper(1) im Explorer) und dann das Makro laufen lassen. Bei Blech muss man die Abwicklung im Explorer markieren und dann das Makro starten.
Code:
Option Explicit

Public Sub Werte_Iprop()

    Dim oDoc As Document
    Set oDoc = ThisApplication.ActiveDocument

    ' Set a reference to component definition of the active document.
    ' This assumes that a part or assembly document is active.
    Dim oCompDef As ComponentDefinition
    Set oCompDef = ThisApplication.ActiveDocument.ComponentDefinition


    ' Make sure something is selected.
    If oDoc.SelectSet.Count = 0 Then
        MsgBox "Bitte vorher Baugruppe auswählen."

        ' Delete any graphics, if they exist.
        On Error Resume Next
        Dim oExistingGraphicsData As GraphicsDataSets
        Set oExistingGraphicsData = oDoc.GraphicsDataSetsCollection.Item("RangeBoxGraphics")
        If Err.Number = 0 Then
            On Error GoTo 0
            Dim oExistingGraphics As ClientGraphics
            Set oExistingGraphics = oCompDef.ClientGraphicsCollection.Item("RangeBoxGraphics")
            oExistingGraphics.Delete
            oExistingGraphicsData.Delete
            ThisApplication.ActiveView.Update
        End If

        Exit Sub
    End If

    ReDim aoRanges(1 To oDoc.SelectSet.Count) As Box
    Dim iRangeCount As Long
    Dim i As Long
    On Error Resume Next
    For i = 1 To oDoc.SelectSet.Count
      Dim oBox As Box
        Set oBox = oDoc.SelectSet.Item(i).RangeBox
        If Err Then
            Err.Clear
            ' Special case for B-Rep entities.
            If oDoc.SelectSet.Item(i).Type = kFaceObject Or _
              oDoc.SelectSet.Item(i).Type = kFaceProxyObject Or _
              oDoc.SelectSet.Item(i).Type = kEdgeObject Or _
              oDoc.SelectSet.Item(i).Type = kEdgeProxyObject Then
                ' Get the range from evaluator of the BRep object.
                Set oBox = oDoc.SelectSet.Item(i).Evaluator.RangeBox
                iRangeCount = iRangeCount + 1
                Set aoRanges(iRangeCount) = oBox
            End If
        Else
            iRangeCount = iRangeCount + 1
            Set aoRanges(iRangeCount) = oBox
        End If
    Next
    On Error GoTo 0

    If iRangeCount = 0 Then
        MsgBox "You must pick object(s) that support a 3D RangeBox property."
        Exit Sub
    End If

    ' Check to see if range box graphics information already exists.
    On Error Resume Next
    Dim oClientGraphics As ClientGraphics
    Dim oLineGraphics As LineGraphics
    Dim oBoxNode As GraphicsNode
    Dim oGraphicsData As GraphicsDataSets
    Set oGraphicsData = oDoc.GraphicsDataSetsCollection.Item("RangeBoxGraphics")
    If Err Then
        Err.Clear
        On Error GoTo 0

        ' Set a reference to the transient geometry object for user later.
        Dim oTransGeom As TransientGeometry
        Set oTransGeom = ThisApplication.TransientGeometry

        ' Create a graphics data set object. This object contains all of the
        ' information used to define the graphics.
        Dim oDataSets As GraphicsDataSets
        Set oDataSets = oDoc.GraphicsDataSetsCollection.Add("RangeBoxGraphics")

        ' Create a coordinate set.
        Dim oCoordSet As GraphicsCoordinateSet
        Set oCoordSet = oDataSets.CreateCoordinateSet(1)

        ' Create the client graphics for this compdef.
        Set oClientGraphics = oCompDef.ClientGraphicsCollection.Add("RangeBoxGraphics")

        ' Create a graphics node.
        Set oBoxNode = oClientGraphics.AddNode(1)
        oBoxNode.Selectable = False

        ' Create line graphics.
        Set oLineGraphics = oBoxNode.AddLineGraphics

        oLineGraphics.CoordinateSet = oCoordSet
    Else
        Set oCoordSet = oGraphicsData.ItemById(1)
        Set oBoxNode = oCompDef.ClientGraphicsCollection.Item("RangeBoxGraphics").ItemById(1)
    End If

    Dim dBoxLines() As Double
    ReDim dBoxLines(1 To 12 * 6 * iRangeCount) As Double
    For i = 0 To iRangeCount - 1
        Dim MinPoint(1 To 3) As Double
        Dim MaxPoint(1 To 3) As Double
        Call aoRanges(i + 1).GetBoxData(MinPoint, MaxPoint)

        ' Line 1
        dBoxLines(i * 72 + 1) = MinPoint(1)
        dBoxLines(i * 72 + 2) = MinPoint(2)
        dBoxLines(i * 72 + 3) = MinPoint(3)
        dBoxLines(i * 72 + 4) = MaxPoint(1)
        dBoxLines(i * 72 + 5) = MinPoint(2)
        dBoxLines(i * 72 + 6) = MinPoint(3)

        ' Line 2
        dBoxLines(i * 72 + 7) = MinPoint(1)
        dBoxLines(i * 72 + 8) = MinPoint(2)
        dBoxLines(i * 72 + 9) = MinPoint(3)
        dBoxLines(i * 72 + 10) = MinPoint(1)
        dBoxLines(i * 72 + 11) = MaxPoint(2)
        dBoxLines(i * 72 + 12) = MinPoint(3)

        ' Line 3
        dBoxLines(i * 72 + 13) = MinPoint(1)
        dBoxLines(i * 72 + 14) = MinPoint(2)
        dBoxLines(i * 72 + 15) = MinPoint(3)
        dBoxLines(i * 72 + 16) = MinPoint(1)
        dBoxLines(i * 72 + 17) = MinPoint(2)
        dBoxLines(i * 72 + 18) = MaxPoint(3)

        ' Line 4
        dBoxLines(i * 72 + 19) = MaxPoint(1)
        dBoxLines(i * 72 + 20) = MaxPoint(2)
        dBoxLines(i * 72 + 21) = MaxPoint(3)
        dBoxLines(i * 72 + 22) = MinPoint(1)
        dBoxLines(i * 72 + 23) = MaxPoint(2)
        dBoxLines(i * 72 + 24) = MaxPoint(3)

        ' Line 5
        dBoxLines(i * 72 + 25) = MaxPoint(1)
        dBoxLines(i * 72 + 26) = MaxPoint(2)
        dBoxLines(i * 72 + 27) = MaxPoint(3)
        dBoxLines(i * 72 + 28) = MaxPoint(1)
        dBoxLines(i * 72 + 29) = MinPoint(2)
        dBoxLines(i * 72 + 30) = MaxPoint(3)

        ' Line 6
        dBoxLines(i * 72 + 31) = MaxPoint(1)
        dBoxLines(i * 72 + 32) = MaxPoint(2)
        dBoxLines(i * 72 + 33) = MaxPoint(3)
        dBoxLines(i * 72 + 34) = MaxPoint(1)
        dBoxLines(i * 72 + 35) = MaxPoint(2)
        dBoxLines(i * 72 + 36) = MinPoint(3)

        ' Line 7
        dBoxLines(i * 72 + 37) = MinPoint(1)
        dBoxLines(i * 72 + 38) = MaxPoint(2)
        dBoxLines(i * 72 + 39) = MinPoint(3)
        dBoxLines(i * 72 + 40) = MaxPoint(1)
        dBoxLines(i * 72 + 41) = MaxPoint(2)
        dBoxLines(i * 72 + 42) = MinPoint(3)

        ' Line 8
        dBoxLines(i * 72 + 43) = MinPoint(1)
        dBoxLines(i * 72 + 44) = MaxPoint(2)
        dBoxLines(i * 72 + 45) = MinPoint(3)
        dBoxLines(i * 72 + 46) = MinPoint(1)
        dBoxLines(i * 72 + 47) = MaxPoint(2)
        dBoxLines(i * 72 + 48) = MaxPoint(3)

        ' Line 9
        dBoxLines(i * 72 + 49) = MaxPoint(1)
        dBoxLines(i * 72 + 50) = MinPoint(2)
        dBoxLines(i * 72 + 51) = MaxPoint(3)
        dBoxLines(i * 72 + 52) = MaxPoint(1)
        dBoxLines(i * 72 + 53) = MinPoint(2)
        dBoxLines(i * 72 + 54) = MinPoint(3)

        ' Line 10
        dBoxLines(i * 72 + 55) = MaxPoint(1)
        dBoxLines(i * 72 + 56) = MinPoint(2)
        dBoxLines(i * 72 + 57) = MaxPoint(3)
        dBoxLines(i * 72 + 58) = MinPoint(1)
        dBoxLines(i * 72 + 59) = MinPoint(2)
        dBoxLines(i * 72 + 60) = MaxPoint(3)

        ' Line 11
        dBoxLines(i * 72 + 61) = MinPoint(1)
        dBoxLines(i * 72 + 62) = MinPoint(2)
        dBoxLines(i * 72 + 63) = MaxPoint(3)
        dBoxLines(i * 72 + 64) = MinPoint(1)
        dBoxLines(i * 72 + 65) = MaxPoint(2)
        dBoxLines(i * 72 + 66) = MaxPoint(3)

        ' Line 12
        dBoxLines(i * 72 + 67) = MaxPoint(1)
        dBoxLines(i * 72 + 68) = MinPoint(2)
        dBoxLines(i * 72 + 69) = MinPoint(3)
        dBoxLines(i * 72 + 70) = MaxPoint(1)
        dBoxLines(i * 72 + 71) = MaxPoint(2)
        dBoxLines(i * 72 + 72) = MinPoint(3)
    Next

    ' Assign the points into the coordinate set.
    Call oCoordSet.PutCoordinates(dBoxLines)

    ' Update the display.
    ThisApplication.ActiveView.Update
     
' Create a string that defines an area using the current length unit.
    Dim oUOM As UnitsOfMeasure
    Set oUOM = ThisApplication.ActiveDocument.UnitsOfMeasure
 
  ' Get the enum value that defines the current default length units.
    Dim eLengthUnit As UnitsTypeEnum
    eLengthUnit = oUOM.LengthUnits

    ' Get the equivalent string of the enum value.
    Dim sLengthUnit As String
    sLengthUnit = " " & oUOM.GetStringFromType(eLengthUnit)
         
    Dim sLänge As String
    Dim sBreite As String
    Dim sStärke As String
   
    Dim rLänge As Double
    Dim rBreite As Double
    Dim rStärke As Double
   
'festlegen, dass Länge immer Lännge, Breite immer Breite und Stärke immer Stärke ist
   
    If (MaxPoint(1) - MinPoint(1)) < (MaxPoint(2) - MinPoint(2)) And (MaxPoint(1) - MinPoint(1)) > (MaxPoint(3) - MinPoint(3)) Then
    rLänge = (MaxPoint(2) - MinPoint(2)) * 10
    rBreite = (MaxPoint(1) - MinPoint(1)) * 10
    rStärke = (MaxPoint(3) - MinPoint(3)) * 10
   
    ElseIf (MaxPoint(1) - MinPoint(1)) < (MaxPoint(3) - MinPoint(3)) And (MaxPoint(1) - MinPoint(1)) > (MaxPoint(2) - MinPoint(2)) Then
    rLänge = (MaxPoint(2) - MinPoint(2)) * 10
    rBreite = (MaxPoint(3) - MinPoint(3)) * 10
    rStärke = (MaxPoint(1) - MinPoint(1)) * 10
   
    ElseIf (MaxPoint(3) - MinPoint(3)) < (MaxPoint(2) - MinPoint(2)) And (MaxPoint(3) - MinPoint(3)) > (MaxPoint(1) - MinPoint(1)) Then
    rLänge = (MaxPoint(3) - MinPoint(3)) * 10
    rBreite = (MaxPoint(1) - MinPoint(1)) * 10
    rStärke = (MaxPoint(2) - MinPoint(2)) * 10
   
    ElseIf (MaxPoint(3) - MinPoint(3)) < (MaxPoint(1) - MinPoint(1)) And (MaxPoint(3) - MinPoint(3)) > (MaxPoint(2) - MinPoint(2)) Then
    rLänge = (MaxPoint(1) - MinPoint(1)) * 10
    rBreite = (MaxPoint(3) - MinPoint(3)) * 10
    rStärke = (MaxPoint(2) - MinPoint(2)) * 10
   
    ElseIf (MaxPoint(2) - MinPoint(2)) < (MaxPoint(3) - MinPoint(3)) And (MaxPoint(2) - MinPoint(2)) > (MaxPoint(1) - MinPoint(1)) Then
    rLänge = (MaxPoint(3) - MinPoint(3)) * 10
    rBreite = (MaxPoint(2) - MinPoint(2)) * 10
    rStärke = (MaxPoint(1) - MinPoint(1)) * 10
   
    Else
    rLänge = (MaxPoint(1) - MinPoint(1)) * 10
    rBreite = (MaxPoint(2) - MinPoint(2)) * 10
    rStärke = (MaxPoint(3) - MinPoint(3)) * 10
    End If
         
    'Dim rLänge As Double
    'rLänge = (MaxPoint(2) - MinPoint(2)) * 10
    sLänge = Format$(rLänge, "###0.0")
       
    'Dim rBreite As Double
    'rBreite = (MaxPoint(1) - MinPoint(1)) * 10
    sBreite = Format$(rBreite, "###0.0")
       
    'Dim rStärke As Double
    'rStärke = (MaxPoint(3) - MinPoint(3)) * 10
    sStärke = Format$(rStärke, "###0.0")
               
    MsgBox "Länge: " & sLänge & sLengthUnit & Chr(13) & Chr(10) & "Breite: " & sBreite & sLengthUnit & Chr(13) & Chr(10) & "Stärke: " & sStärke & sLengthUnit
   
    sLänge = Replace(sLänge, ",", ".", vbTextCompare)
    sBreite = Replace(sBreite, ",", ".", vbTextCompare)
    sStärke = Replace(sStärke, ",", ".", vbTextCompare)
   
    'Benutzerdefinierten Eintrag erzeugen
    'Länge vorhanden?
    Dim bLängeDa As Boolean
    Dim oProp As Property
    bLängeDa = False
    For Each oProp In oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")  'Benutzerdefiniert
        If oProp.Name = "Länge" Then
            bLängeDa = True
            Exit For
        End If
    Next
    'Länge eintragen oder ändern
    If bLängeDa Then
        oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("Länge").Value = sLänge
    Else
        oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add sLänge, "Länge"
    End If
   
        'Breite vorhanden?
    Dim bBreiteDa As Boolean
    bBreiteDa = False
    For Each oProp In oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")  'Benutzerdefiniert
        If oProp.Name = "Breite" Then
            bBreiteDa = True
            Exit For
        End If
    Next
    'Breite eintragen oder ändern
    If bBreiteDa Then
        oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("Breite").Value = sBreite
    Else
        oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add sBreite, "Breite"
    End If
   
    'Stärke vorhanden?
    Dim bStärkeDa As Boolean
    bStärkeDa = False
    For Each oProp In oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}")  'Benutzerdefiniert
        If oProp.Name = "Stärke" Then
            bStärkeDa = True
            Exit For
        End If
    Next
    'Höhe eintragen oder ändern
    If bStärkeDa Then
        oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Item("Stärke").Value = sStärke
    Else
        oDoc.PropertySets("{D5CDD505-2E9C-101B-9397-08002B2CF9AE}").Add sStärke, "Stärke"
    End If
   
   
    'Da die ClientGraphic nur temporär sein soll, wird sie nach Bestätigen
    'der Meldung wieder gelöscht.
    If oDoc.SelectSet.Count = 0 Then
   
    ' Delete any graphics, if they exist.
    On Error Resume Next
    Set oExistingGraphicsData = oDoc.GraphicsDataSetsCollection.Item("RangeBoxGraphics")
    If Err.Number = 0 Then
        On Error GoTo 0
        Set oExistingGraphics = oCompDef.ClientGraphicsCollection.Item("RangeBoxGraphics")
        oExistingGraphics.Delete
        oExistingGraphicsData.Delete
        ThisApplication.ActiveView.Update
    End If

    Exit Sub
    End If
End Sub



Dieses Makro gibt immer die längste Seite als Länge und die kürzeste als Stärke wieder. Ich denke, man kann das alles eleganter aufbauen, wahrscheinlich auch deutlich kürzer aber meine Kenntnisse reichen leider nicht so weit.
Gruss Didi

------------------
Didi

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

Didikalle
Mitglied
Konstrukteur


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

Beiträge: 91
Registriert: 07.10.2011

Ich nutze Inventor 2016 mit dem BS Win 10

erstellt am: 07. Apr. 2015 14:23    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 Zusammen,

ich denke, hier ist alles gesagt. Ich habe diesen Code noch etwas überarbeitet und mit einem Zugriff auf den Inv.Browser verknüpft.
siehe diesen Link: http://ww3.cad.de/foren/ubb/Forum258/HTML/001623.shtml

Gruss Didi

------------------
Didi

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