cherche codeur pour macro VBA pour inventor

[adenia]

Bonjour

 

Je cherche quelqu'un qui pourrai m'aider, je n'y connai rien du tout en programmation mais j'ai besoin d'une marco et je ne sais pas ou me tourne

 

Dans 1 assemblage je doit resortir les longueur, largeur et epaisseur de chaque pièces pour les retrouver dans la nomenclature

 

Après recheche je pense qu'il y a 1 solution avec la commande "box" et "max.point" et "min.point"

 

En fait la macroit doit detreminer les valeur par calcul " max.point - min.point" sur les plan X, Y et Z

 

Enfin elle doit les comparer pour leur attribué un nom

 

La plus grande pour la longueur -> lo

La plus petite pour l'epasseur -> ep

la dernière pour la largerur-> la

et les mettres dans les ipropriéter pour l'export dans la nomencaltue

 

voila merci pour votre aide

[nomutt]

Bonjour,

 

Je cherche quelqu'un qui pourrai m'aider, je n'y connai rien du tout en programmation mais j'ai besoin d'une marco et je ne sais pas ou me tourne

 

Je suis à ton service !

 

[adenia]

Bonjour et merci de ton aide

 

As tu besoin de plus d'informations pour comprendre ce que je recherche

 

Pour être plus complet on travail avec un shema de conception, maintenant avec 2010 en multi-body pour faire nos assemblage.

 

Je travail dans l'agencement et inventor n'est pas top solid wood donc ne sort pas automatiquement les debit des panneaux. C'est ce que je recherche,en farfouillant dans le web j'ai trouver un debut qui donne ceci mais c'est pour les pieces metal

 

Dim objpartDoc As PartDocument

Set objpartDoc = ThisApplication.ActiveDocument

Dim objCompDef As SheetMetalComponentDefinition

Set objCompDef = objpartDoc.ComponentDefinition

Dim fpBox As Box

Set fpBox = objCompDef.FlatPattern.Body.RangeBox

Dim width As Double

Dim length As Double

 

length = fpBox.MaxPoint.X - fpBox.MinPoint.X

width = fpBox.MaxPoint.Y - fpBox.MinPoint.Y

 

Dim objUOM As UnitsOfMeasure

Set objUOM = objpartDoc.UnitsOfMeasure

 

Dim strLength As String

Dim strWidth As String

 

strLength = objUOM.GetStringFromValue(length, UnitsTypeEnum.kDefaultDisplayLengthUnits)

strWidth = objUOM.GetStringFromValue(width, UnitsTypeEnum.kDefaultDisplayLengthUnits)

 

Call MsgBox("Width = " + strWidth + vbCrLf + "Length = " + strLength, vbOKOnly, "Sheet Metal Flat Pattern")

 

Call Create_ext_prop("width", strWidth)

Call Create_ext_prop("length", strLength)

 

Je pense que ça doit être possible

 

merci

 

[nomutt]

Bonjour,

 

Ce code n'est pas trop compliqué en effet mais il manque le principal, c'est à dire la Sub nommée Create_ext_prop.

Autre point un peu délicat, gérer les corps solides. Je ne sais pas si il y a ce qu'il faut dans les API.

 

[adenia]

"Autre point un peu délicat, gérer les corps solides. Je ne sais pas si il y a ce qu'il faut dans les API."

 

En fait je veux pouvoir lancer la macro dans un assemblage ou chaque fichier est une pièces

[adenia]

il manque ceci peut etre

 

Sub Create_ext_prop(prop As String, prop_value As String)

 

Dim opropsets As PropertySets

Dim opropset As PropertySet

Dim oUserPropertySet As PropertySet

 

Set opropsets = ThisApplication.ActiveDocument.PropertySets

 

For Each opropset In opropsets

If opropset.Name = "Inventor User Defined Properties" Then Set oUserPropertySet = opropset

Next opropset

 

' If Property does not exist then add the new Property

On Error Resume Next

Call oUserPropertySet.Add(prop_value, prop)

' Try to set the Property value if it already exists

 

For i = 1 To oUserPropertySet.Count

If oUserPropertySet.Item(i).Name = prop Then oUserPropertySet.Item(i).Value = prop_value

Next i

 

End Sub

 

 

je ne fait que du copier coller

 

le problème cest que cette marco n'a jamais fonctionne chez moi

 

 

[nomutt]

Bonjour,

 

Je suis un peu débordé actuellement. Dès que j'ai un peu de temps, je regarde à tout ça.

 

[adenia]

Bonjour un petit up pour voir si on ne ma pas oublié

 

merci