Guss_ | Pour le moment elle n'est pas encore tout à fait fiable, il y a des petits détails sur la manière de fonctionner qui sont encore à adapter
J'ai une petite interface qui gère ça
Avec des zones qui correspondent aux éléments de mon cartouche
macro principale
Code :
- Sub CATMain()
- Load Gestionaire_2
- Gestionaire_2.Show
- End Sub
|
macro de l'interface Gestionaire_2
Code :
- Public update_manu As Boolean, typedoc As String
- Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
- (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, _
- ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
- Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _
- (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, _
- ByVal lpFileName As String) As Long
-
- Private Function LitDansFichierIni(Section As String, Cle As String, Fichier As String, _
- Optional ValeurParDefaut As String = "" ) As String
- Dim strReturn As String
- strReturn = String(255, 0)
- GetPrivateProfileString Section, Cle, ValeurParDefaut, strReturn, Len(strReturn), Fichier
- LitDansFichierIni = Left(strReturn, InStr(strReturn, Chr(0)) - 1)
- End Function
- Private Function EcritDansFichierIni(Section As String, Cle As String, _
- Valeur As String, Fichier As String) As Long
- EcritDansFichierIni = WritePrivateProfileString(Section, Cle, Valeur, Fichier)
- End Function
- Private Sub Chk_ensemble_Change()
- If Chk_ensemble.Value = True Then
- txt_num_piece.Text = "00"
- End If
- End Sub
- Private Sub Chk_ensemble_Click()
- End Sub
- Private Sub txt_chemin_Change()
- End Sub
- Private Sub btn_enregistre_config_Click()
- enregistre_
- End Sub
- Private Sub enregistre_auto_Click()
- End Sub
- Private Sub txt_num_piece_Change()
- End Sub
- Private Sub UserForm_Activate()
- '---------initialisation
- Dim nomprojet As String
- '---------initialisation des variables
- nomprojet = "gestionaire_v1.1"
- num_projet = cherche_conf(nomprojet, "num_projet" )
- num_sous_projet = cherche_conf(nomprojet, "num_sous_projet" )
- num_piece = ""
- indice = cherche_conf(nomprojet, "indice" )
- nom_ensemble = ""
- nom_projet = cherche_conf(nomprojet, "nom_projet" )
- nom_sous_projet = cherche_conf(nomprojet, "nom_sous_projet" )
- auteur = cherche_conf(nomprojet, "auteur" )
- date_ = cherche_conf(nomprojet, "date_" )
- enregistre_auto.Value = cherche_conf(nomprojet, "enregistre_auto" )
- type_doc = ""
-
- '---------initalisation de la fenetre
- txt_num_projet.Text = num_projet
- txt_num_sous_projet.Text = num_sous_projet
- txt_num_piece.Text = num_piece
- txt_indice.Text = indice
- txt_nom_ensemble.Text = nom_ensemble
- txt_nom_projet.Text = nom_projet
- txt_nom_sous_projet.Text = nom_sous_projet
- txt_auteur.Text = auteur
- txt_date.Text = date_
- update_manu = False
- btn_date.Enabled = True
- btn_rempli_cartouche.Enabled = True
- btn_enregistre_config.Enabled = False
-
- '---------detection du type de document en cours
- 'On Error GoTo erreur
- Dim productDocument1 As Document
- Set productDocument1 = CATIA.ActiveDocument
- typedoc = TypeName(productDocument1)
-
-
- If typedoc = "DrawingDocument" Then
- Set drawingDocument1 = CATIA.ActiveDocument
- Set drawingSheets1 = drawingDocument1.Sheets
- Set drawingSheet1 = drawingSheets1.Item("Calque.1" )
- Set drawingViews1 = drawingSheet1.Views
- Set vue_active = drawingViews1.ActiveView
- Set drawingView1 = drawingViews1.Item("Main View" )
- Set drawingTexts1 = drawingView1.Texts
- Set zone_text_nom = drawingTexts1.GetItem("nom" )
- debug_nom.Caption = CATIA.ActiveDocument.Sheets.Name
- If vue_active.Name = "Main View" Then
- MsgBox ("veuilliez séléctioner une vue" )
- Else
- nom_piece_3D = vue_active.GenerativeBehavior.Document.ReferenceProduct.Name
- zone_texte_chemin.Text = vue_active.GenerativeBehavior.Document.ReferenceProduct.Parent.Path + "\"
- zone_text_nom.Text = Replace(nom_piece_3D, "_", " " )
- txt_nom_ensemble.Text = zone_text_nom.Text
- txt_num_piece.Text = dernier_plan(zone_texte_chemin.Text, "34_" & num_projet & "_" & num_sous_projet & "_" )
- btn_enregistre_config.Enabled = True
- End If
-
- '---- affichage des bouton correspondant au drawing
- lab_type_doc.Caption = typedoc
- btn_rempli_cartouche.Enabled = True
-
- End If
-
-
- Exit Sub
- erreur:
- MsgBox "aucun document ouvert"
- End Sub
- Private Sub btn_choix_repertoire_Click()
- txt_chemin.Text = choix_rep("choix du repertoire de travail" )
- End Sub
- Private Sub btn_date_Click()
- txt_date.Text = Format(Date, "dd/mm/yyyy" )
- End Sub
- Private Sub btn_enregistre_Click()
- On Error Resume Next
- chemin = txt_chemin.Text & "\"
-
- If typedoc = "DrawingDocument" Then
- CATIA.ActiveDocument.SaveAs (zone_texte_chemin.Text & "34_" & txt_num_projet.Text & "_" & txt_num_sous_projet.Text & "_" & txt_num_piece & "_" & txt_nom_ensemble.Text & ".CATDrawing" )
- End If
- If enregistre_auto.Value = True Then
- enregistre_
- End If
-
- End
- End Sub
- Private Sub enregistre_()
- Dim conf_file As String, selec As String, User_path As String, FileObj As File, data As String, nomprojet As String
- '--- determination du chemin du fichier de configuration suivant les paramètres utilisateur
- nomprojet = "gestionaire_v1.1"
- Set WshShell = CreateObject("WScript.Shell" )
- Set WshSysEnv = WshShell.Environment("PROCESS" )
- User_path = WshSysEnv("USERPROFILE" )
- conf_file = User_path & "\AppData\Roaming\DassaultSystemes\CATSettings\macros_setting.ini"
- test_f = CATIA.FileSystem.FileExists(conf_file)
- If test_f = False Then
- '--- si le fichier de configuration n'existe pas, on le créé
- Set FileObj = CATIA.FileSystem.CreateFile(conf_file, True)
- End If
- EcritDansFichierIni nomprojet, "num_projet", txt_num_projet.Text, conf_file
- EcritDansFichierIni nomprojet, "num_sous_projet", txt_num_sous_projet.Text, conf_file
- EcritDansFichierIni nomprojet, "indice", txt_indice.Text, conf_file
- EcritDansFichierIni nomprojet, "nom_projet", txt_nom_projet.Text, conf_file
- EcritDansFichierIni nomprojet, "nom_sous_projet", txt_nom_sous_projet.Text, conf_file
- EcritDansFichierIni nomprojet, "auteur", txt_auteur.Text, conf_file
- EcritDansFichierIni nomprojet, "date_", txt_date.Text, conf_file
- EcritDansFichierIni nomprojet, "enregistre_auto", enregistre_auto.Value, conf_file
-
- End Sub
- Private Sub btn_recup_infos_Click()
- Set drawingDocument1 = CATIA.ActiveDocument
- Set drawingSheets1 = drawingDocument1.Sheets
- Set drawingSheet1 = drawingSheets1.Item("Calque.1" )
- Set drawingViews1 = drawingSheet1.Views
- Set drawingView1 = drawingViews1.Item("Main View" )
- Set drawingTexts1 = drawingView1.Texts
-
- Set zone_text_nom = drawingTexts1.GetItem("nom" )
- Set zone_text_indice = drawingTexts1.GetItem("indice" )
- Set zone_text_repere = drawingTexts1.GetItem("repere" )
- Set zone_text_num_projet = drawingTexts1.GetItem("projet" )
- Set zone_text_nom_projet = drawingTexts1.GetItem("Nom_Projet" )
- Set zone_text_sous_projet = drawingTexts1.GetItem("Nom_sous_Projet" )
- Set zone_text_auteur = drawingTexts1.GetItem("createur" )
- Set zone_text_date = drawingTexts1.GetItem("date_creation" )
-
- ' ---------verification d'un plan existant
- txt_indice.Text = zone_text_indice.Text
- txt_num_piece.Text = zone_text_repere.Text
- txt_nom_ensemble.Text = zone_text_nom.Text
- txt_num_projet.Text = Left(zone_text_num_projet.Text, 4)
- txt_num_sous_projet.Text = Right(zone_text_num_projet.Text, 2)
- txt_nom_projet.Text = zone_text_nom_projet.Text
- txt_nom_sous_projet.Text = zone_text_sous_projet.Text
- txt_auteur.Text = zone_text_auteur.Text
- txt_date.Text = zone_text_date.Text
- End Sub
- Private Sub btn_rempli_cartouche_Click()
- Dim FileSys
- Set drawingDocument1 = CATIA.ActiveDocument
- Set drawingSheets1 = drawingDocument1.Sheets
- Set drawingSheet1 = drawingSheets1.Item("Calque.1" )
- Set drawingViews1 = drawingSheet1.Views
- Set drawingView1 = drawingViews1.Item("Main View" )
- Set drawingTexts1 = drawingView1.Texts
-
- Set zone_text_nom = drawingTexts1.GetItem("nom" )
- Set zone_text_indice = drawingTexts1.GetItem("indice" )
- Set zone_text_repere = drawingTexts1.GetItem("repere" )
- Set zone_text_num_projet = drawingTexts1.GetItem("projet" )
- Set zone_text_nom_projet = drawingTexts1.GetItem("Nom_Projet" )
- Set zone_text_sous_projet = drawingTexts1.GetItem("Nom_sous_Projet" )
- Set zone_text_auteur = drawingTexts1.GetItem("createur" )
- Set zone_text_date = drawingTexts1.GetItem("date_creation" )
-
- ' ---------verification d'un plan existant
- zone_text_indice.Text = txt_indice.Text
- zone_text_repere.Text = txt_num_piece.Text
- zone_text_nom.Text = txt_nom_ensemble.Text
- zone_text_num_projet.Text = txt_num_projet.Text & "_" & txt_num_sous_projet.Text
- zone_text_nom_projet.Text = txt_nom_projet.Text
- zone_text_sous_projet.Text = txt_nom_sous_projet.Text
- zone_text_auteur.Text = txt_auteur.Text
- zone_text_date.Text = txt_date.Text
- End Sub
- Private Sub txt_nom_projet_AfterUpdate()
- maj_chemin
- End Sub
- Private Sub maj_chemin()
- If txt_chemin = "" Or update_manu = True Then
- If txt_nom_sous_projet.Text = "" Then
- txt_chemin = "g:\" + txt_nom_projet.Text
- Else
- txt_chemin = "g:\" + txt_nom_projet.Text + "\" + txt_nom_sous_projet.Text
- End If
- update_manu = True
- End If
- End Sub
- Private Sub txt_nom_sous_projet_AfterUpdate()
- maj_chemin
- End Sub
- Function choix_rep(titre)
- Set objShell = CreateObject("shell.Application" )
- Set objFolder = objShell.BrowseForFolder(0, titre, 0)
- If (Not objFolder Is Nothing) Then
- choix_rep = objFolder.Items.Item.Path
- End If
- Set objFolder = Nothing
- Set objShell = Nothing
- End Function
- Private Sub btn_pdf_Click()
- End Sub
- Private Function cherche_conf(macro As String, Section As String) As String
- Dim conf_file As String, selec As String, User_path As String, FileObj As File, data As String
- '--- determination du chemin du fichier de configuration suivant les paramètres utilisateur
- Set WshShell = CreateObject("WScript.Shell" )
- Set WshSysEnv = WshShell.Environment("PROCESS" )
- User_path = WshSysEnv("USERPROFILE" )
- conf_file = User_path + "\AppData\Roaming\DassaultSystemes\CATSettings\macros_setting.ini"
- test_f = CATIA.FileSystem.FileExists(conf_file)
-
- If test_f = True Then
- '--- si le ficher de configuration existe on lit la configuration
- data = LitDansFichierIni(macro, Section, conf_file)
- Else
- '--- si le fichier de configuration n'existe pas, on renvoie une donnée nul
- data = ""
- End If
- cherche_conf = data
- End Function
- Function dernier_plan(chemin, debut_fichier As String)
- ' ---- cette fonction permet de determiner le dernier plan du projet et de génarer le prochain numéro
- Dim FSO
- Set FSO = CreateObject("Scripting.FileSystemObject" )
- rep = chemin
- compte = "0"
- Set contenu_rep = FSO.GetFolder(rep)
- For Each Fichier In contenu_rep.Files
- If (InStr(1, Fichier.Name, ".catdrawing", 1) > 0) Then
- If (InStr(1, Fichier.Name, debut_fichier, 1) > 0) Then
- test = Replace(Fichier.Name, debut_fichier, "" )
- test = (Left(test, 2))
- If test >= compte Then
- compte = test
- End If
- End If
- End If
- Next
- If compte + 1 < 10 Then
- compte = "0" & (compte + 1)
- Else
- compte = compte + 1
- End If
- dernier_plan = compte
- End Function
- Private Sub UserForm_Terminate()
- If enregistre_auto.Value = True Then
- enregistre_
- End If
- End Sub
|
Il ya pas mal d'éléments que tu n'as pas peut être pas besoins ou d'autre a rajouter
J'ai notamment une procédure qui permet d'enregistrer mes paramètres dans un fichier .ini dans les catsettings |