Sujet Précédent Sujet Suivant

Appel de procédure et de fonctions

flabrousse Messages postés 12 Date d'inscription jeudi 19 janvier 2006 Statut Membre Dernière intervention 22 mai 2006 - 8 mars 2006 à 09:42
jrivet Messages postés 7392 Date d'inscription mercredi 23 avril 2003 Statut Membre Dernière intervention 6 avril 2012 - 8 mars 2006 à 11:18
Bonjour,

J'ai des petits soucis d'écriture. Je travaille sous CATIA et j'ai fait une macro en VBScript qui va lire des coordonnées dans un fichier puis va générer les points associés.
J'aimerai alléger cette macro car j'ai écrit deux fois les même fontions suivant si il s'agit d'un fichier excel ou texte. Le but serait d'écrire une seule fois chaque fonction et les appeller, mais je sais pas faire!!!

Je vous joint ci dessous ce que j'ai fait.
Les fonction que je souhaiterai rappeler dans cette macro sont entre autre "choix de la couleur", "creation du point centre", "changement couleur"

Merci d'avance vont vos conseils et renseignements


Language="VBSCRIPT"


Sub CATMain()


' FENETRE DE SELECTION DE FICHIER
MonFich = CATIA.FileSelectionBox("Sélection du fichier texte", "*.txt;*.xls", CatFileSelectionModeOpen)


' CREATION D'UNE INSTANCE DE FSO
Set Fso = CreateObject("scripting.filesystemobject")

' FICHIER .TXT '
If Right(MonFich,4) = ".txt" And Fso.FileExists(MonFich) Then


Set fichier = Fso.getfile(MonFich)
Set Stream = fichier.OpenAsTextStream(ForReading, TristateUseDefault)

' AJOUT D'UN CORPS DE PIECE
''''''''''''''''''''''''''''''''''''''''''''''''''''
Set partDocument1 = CATIA.ActiveDocument
Set part1 = partDocument1.Part
Set bodies1 = part1.Bodies
Set body1 = bodies1.Add()


' PREPARATION DE LECTURE DU FICHIER
''''''''''''''''''''''''''''''''''''''''''''''''''''
Const ForReading 1, ForWriting 2, ForAppending = 3Const TristateUseDefault -2, TristateTrue -1, TristateFalse = 0
Dim x, y, z, r, q
Dim couleur, MonFich, ligne
Dim Rouge
Dim Vert
Dim Bleu
Dim Chaine, Stream
Dim Fso
Dim fichier

' LECTURE ET EXECUTION
''''''''''''''''''''''''''''''''''''''''''''''''''''

While Not Stream.AtEndOfStream
ligne = Stream.readline ' lecture de chaque ligne du fichier
Chaine = ""
For i = 1 To Len(ligne)
Chaine = Chaine + Mid(ligne, i, 1)
Next


' LECTURE PREMIERE LIGNE
''''''''''''''''''''''''''''''''''''''''''''''''''''

q = InStr(Chaine, " ") ' position 1° espace
x = Left(Chaine, q - 1) ' récupère 78,88 de la première ligne
Chaine = Right(Chaine, Len(Chaine) - q)
q = InStr(Chaine, " ") ' position 2° espace
y = Left(Chaine, q - 1) ' récupère -57,90 de la première ligne
Chaine = Right(Chaine, Len(Chaine) - q)
q = InStr(Chaine, " ") ' position 3° espace
z = Left(Chaine, q - 1) ' récupère 11,60 de la première ligne
Chaine = Right(Chaine, Len(Chaine) - q)q InStr(Chaine, " ") ' position 4° espacer Left(Chaine, q - 1) ' récupère 6,87 de la première ligne
couleur = Trim(Right(Chaine, Len(Chaine) - q)) ' récupère la couleur


' CHOIX COEFFICIENTS COULEURS
''''''''''''''''''''''''''''''''''''''''''''''''''''

If couleur = "rouge" Then
Rouge = 255
Vert = 0
Bleu = 0
Else If couleur = "vert" Then
Rouge = 0
Vert = 255
Bleu =0
Else If couleur = "bleu" Then
Rouge = 0
Vert = 0
Bleu = 25
Else If couleur = "jaune" Then
Rouge = 255
Vert = 255
Bleu = 0
Else If couleur = "blanc" Then
Rouge = 255
Vert = 255
Bleu = 255
Else If couleur = "noir" Then
Rouge = 0
Vert = 0
Bleu = 0
Else If couleur = "magenta" Then
Rouge = 255
Vert = 0
Bleu = 255
End If
End If
End If
End If
End If
End If
End If

' CREATION DU POINT DE CENTRE (x ,y, z)
''''''''''''''''''''''''''''''''''''''''''''''''''''

Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridShapePointCoord0 = hybridShapeFactory1.AddNewPointCoord( x, y, z)
body1.InsertHybridShape hybridShapePointCoord0
part1.InWorkObject = hybridShapePointCoord0

' CHANGEMENT DE COULEUR
''''''''''''''''''''''''''''''''''''''''''''''''''''

Set selection1 = partDocument1.Selection
Set visPropertySet1 = selection1.VisProperties
Set hybridShapes1 = hybridShapePointCoord0.Parent
Dim bSTR4
bSTR4 =hybridShapePointCoord0.Name
selection1.Add hybridShapePointCoord0
Set VisPropSet1 = selection1.VisProperties
VisPropSet1.SetRealColor Rouge, Vert, Bleu, 1
selection1.Clear

' MISE A JOUR DU PART
''''''''''''''''''''''''''''''''''''''''''''''''''''
part1.Update

Wend
Stream.Close ' ferme le fichier





' FICHIER .XLS '
''''''''''''''''''''''''''''''''''''''''''''''''''''
Else If Right(MonFich,4) = ".xls" And Fso.FileExists(MonFich) Then
' AJOUT D'UN CORPS DE PIECE
''''''''''''''''''''''''''''''''''''''''''''''''''''
Set partDocument1 = CATIA.ActiveDocument
Set part1 = partDocument1.Part
Set bodies1 = part1.Bodies
Set body1 = bodies1.Add()

' OUVERTURE DU FICHIER EXCEL
''''''''''''''''''''''''''''''''''''''''''''''''''''
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Workbooks.Open MonFich

' EXECUTION
''''''''''''''''''''''''''''''''''''''''''''''''''''
i=1
With ExcelApp.ActiveWorkbook.Sheets.Item(1)
Do
While .Cells(i, 1).Value <> ""

' AFFECTATION DES VALEURS
''''''''''''''''''''''''''''''''''''''''''''''''''''
x = .Cells(i, 1).Value
y = .Cells(i, 2).Value
z = .Cells(i, 3).Value
r = .Cells(i, 4).Value
couleur = .Cells(i, 5).Value

' CHOIX COEFFICIENTS COULEURS
''''''''''''''''''''''''''''''''''''''''''''''''''''

If couleur = "rouge" Then
Rouge = 255
Vert = 0
Bleu = 0
Else If couleur = "vert" Then
Rouge = 0
Vert = 255
Bleu =0
Else If couleur = "bleu" Then
Rouge = 0
Vert = 0
Bleu = 25
Else If couleur = "jaune" Then
Rouge = 255
Vert = 255
Bleu = 0
Else If couleur = "blanc" Then
Rouge = 255
Vert = 255
Bleu = 255
Else If couleur = "noir" Then
Rouge = 0
Vert = 0
Bleu = 0
Else If couleur = "magenta" Then
Rouge = 255
Vert = 0
Bleu = 255
End If
End If
End If
End If
End If
End If
End If

' CREATION DU POINT DE CENTRE (x ,y, z)
''''''''''''''''''''''''''''''''''''''''''''''''''''

Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridShapePointCoord0 = hybridShapeFactory1.AddNewPointCoord( x, y, z)
body1.InsertHybridShape hybridShapePointCoord0
part1.InWorkObject = hybridShapePointCoord0

' CHANGEMENT DE COULEUR
''''''''''''''''''''''''''''''''''''''''''''''''''''

Set selection1 = partDocument1.Selection
Set visPropertySet1 = selection1.VisProperties
Set hybridShapes1 = hybridShapePointCoord0.Parent
Dim bSTR4
bSTR4 =hybridShapePointCoord0.Name
selection1.Add hybridShapePointCoord0
Set VisPropSet1 = selection1.VisProperties
VisPropSet1.SetRealColor Rouge, Vert, Bleu, 1
selection1.Clear

' MISE A JOUR DU PART
''''''''''''''''''''''''''''''''''''''''''''''''''''
part1.Update


' INCREMENTATION
''''''''''''''''''''''''''''''''''''''''''''''''''''

i=i+1

Wend
Exit Do
Loop
End With
ExcelApp.Quit 'fermeture du fichier excel

Else
MsgBox "Fichier non valide"
End If
End If
End Sub

1 réponse

Réponse 1 / 1
jrivet Messages postés 7392 Date d'inscription mercredi 23 avril 2003 Statut Membre Dernière intervention 6 avril 2012 60
8 mars 2006 à 11:18
Salut,

Essaie de voir si ce qui suit peux t'aider.

Sub CreateCentralPoint(x, y, z)
Set hybridShapeFactory1 = part1.HybridShapeFactory
Set hybridShapePointCoord0 = hybridShapeFactory1.AddNewPointCoord( x, y, z)
body1.InsertHybridShape hybridShapePointCoord0
part1.InWorkObject = hybridShapePointCoord0
End Sub

Ensuite a chaque endroit ou tu avais le code inscrit dans la fonction, tu le remplace par:

CreateCentralPoint(x, y, z)

et ainsi de suite pour creer les autres fonction

@+, Julien
Pensez: Moteur de Recherche, Réponse Acceptée
0

Discussions similaires

Comment fonctionne la fonction FormulaR1C1
cs_razmokets -
wape -

2 réponses
fonction modulo en VBA
krisprolss -
Benouille -

2 réponses
Dernière cellule non vide d'une colonne
cs_falafala -
Luigi13013 -

5 réponses
A quoi sert la fonction Set ?
ICIoBRa -
ICIoBRa -

3 réponses
Modulo pour chiffres à virgule
cs_ebro -
Gally -

8 réponses
Rejoignez-nous