Discussion :

[GANDHIHP]

Bonjour à tous,
J'ai fait une première ébauche d'un lisp Autocad 2013. Par contre je n'arrive pas à filtrer la liste des modèles avec ceux contenus dans chacun des fichiers du répertoire courant. (2ème partie).
Actuellement le lisp ci-dessous, après avoir mis à jour le dessin ouvert, en deuxième partie insert tous les blocs de la liste des modèles dans les dessins. Je pense qu'il manque un focus après l'ouverture des fichiers du répertoire pour exécuter des commandes sur chacun des fichiers ouverts successivements. Mis en ( ;;;==== NE MARCHE PAS ) dans le lisp.
Merci par avance de votre aide.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
(vl-load-com)
 
(defun folderbox1 (message / sh folder result)
    (setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application"))
    (setq folder (vlax-invoke-method sh 'browseforfolder 0 message 0))
    (vlax-release-object sh)
    (if folder
      (progn (setq result (vlax-get-property (vlax-get-property folder 'self) 'path))
             (if (wcmatch result "*\\")
               result
               (strcat result "\\")
             )
      )
    )
  )
 
 
 
(defun Ouvrir_dessin_dbx1 (dwg / dbx)
(if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
(setq dbx (vlax-create-object "ObjectDBX.AxDbDocument"))
(setq dbx (vlax-create-object (strcat "ObjectDBX.AxDbDocument." (substr (getvar "ACADVER") 1 2))))
)
(vla-open dbx dwg)
dbx
)
 
 
 
 
(defun c:test ( / dir files f b )
;;;---diallogbx
  (if (setq dir (folderbox1 "Selectionner un dossier avec des gabarits")
            files (vl-directory-files dir "*.dwg" 1)
      )
 
    (progn
      (foreach f files 
       (if (tblsearch "block" (vl-filename-base f))
(progn
(setq fichier (strcat dir "\\" f))
(setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
 
 
(setq mspace2 (vla-get-modelspace thisdrawing))
 
 
 
(setq obj2 (vla-InsertBlock
mspace2
(vlax-3d-point '(0 0 0))
fichier
1
1
1
0
))
;(tblsearch "block" (setq b (vl-filename-base f)))
(vla-delete obj2)
)))
(princ (strcat "\n...Dessin courant...ok (!) actualiser avec regen"  "\n"))(princ)
))
;;; (2ème partie)
                    ;;;---liste des dessins du repertoire
                    (setq rep (substr (getvar "dwgprefix") 1 (1- (strlen (getvar "dwgprefix")))))
 
                    (if (setq lst (vl-directory-files rep "*.dwg" 1))
                      (progn
                        (and (eq (strcase rep) (strcase (substr (getvar "dwgprefix") 1 (1- (strlen (getvar "dwgprefix"))))))
                          (setq lst (vl-remove (getvar "dwgname") lst))
                        )
(progn
                     ;;;---for each liste du dossier courant
                        (foreach fic lst
                               (princ (strcat "\n...Ouverture sur " fic "...ok \n"))(princ)
                         (if (setq dbx (ouvrir_dessin_dbx1 (strcat rep "\\" fic)))
                            (progn
                             ;;;---for each du dossier des modèles choisis
                             (foreach f (vl-directory-files dir "*.dwg" 0)
       ;;;==== NE MARCHE PAS (if (tblsearch "block" (vl-filename-base f))
(progn                       
 
                                      (setq fichier1 (strcat dir f))
 
(progn
(setq sp1 (vla-get-ModelSpace dbx))
 
(setq obj1 (vla-InsertBlock
sp1
(vlax-3d-point '(0 0 0))
fichier1
1
1
1
0
))
(vla-delete obj1)
)
)
 ) ;;;===== NE MARCHE PAS)
(princ (strcat "\n...Sauvegarde sur " fic "...ok \n"))(princ)
                         (vla-saveas dbx (strcat rep "\\" fic))
                          (vlax-release-object dbx)
                              ) 
                            ) 
                         )   
                      )
                        )
                      )
  )

[GANDHIHP]

Bonjour, le lisp escompté marche enfin avec mes remerciements pour HMSILVA d'Autodesk community. Le voici en post :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
 
;***********************************************************
;***********************************************************
;***************** TEST *************************************
 
(vl-load-com)
 
(defun folderbox1 (message / sh folder result)
    (setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application"))
    (setq folder (vlax-invoke-method sh 'browseforfolder 0 message 0))
    (vlax-release-object sh)
    (if	folder
      (progn (setq result (vlax-get-property (vlax-get-property folder 'self) 'path))
	     (if (wcmatch result "*\\")
	       result
	       (strcat result "\\")
	     )
      )
    )
  )
 
 
 
(defun Ouvrir_dessin_dbx1 (dwg / dbx)
(if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
(setq dbx (vlax-create-object "ObjectDBX.AxDbDocument"))
(setq dbx (vlax-create-object (strcat "ObjectDBX.AxDbDocument." (substr (getvar "ACADVER") 1 2))))
)
(vla-open dbx dwg)
dbx
)
 
 
 
 
(defun c:test ( / dir files f b )
;;;---diallogbx
  (if (setq dir (folderbox1 "Selectionner un dossier avec des gabarits")
            files (vl-directory-files dir "*.dwg" 1)
      )
 
    (progn
      (foreach f files 
       (if (tblsearch "block" (setq b (vl-filename-base f)))
(progn
(setq fichier2 (strcat dir "\\" f))
(setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
 
 
(setq mspace2 (vla-get-modelspace thisdrawing))
 
 
 
(setq obj2 (vla-InsertBlock
mspace2
(vlax-3d-point '(0 0 0))
fichier2
1
1
1
0
))
(vla-delete obj2)
)))
(princ (strcat "\n...Dessin courant...ok (!) actualiser avec regen"  "\n"))(princ)
))
                    ;;;---liste des dessins du repertoire
                    (setq rep (substr (getvar "dwgprefix") 1 (1- (strlen (getvar "dwgprefix")))))
 
                    (if (setq lst (vl-directory-files rep "*.dwg" 1))
                      (progn
                        (and (eq (strcase rep) (strcase (substr (getvar "dwgprefix") 1 (1- (strlen (getvar "dwgprefix"))))))
                          (setq lst (vl-remove (getvar "dwgname") lst))
                        )
(progn
                     ;;;---for each liste du dossier courant
                        (foreach fic lst
 
                               (princ (strcat "\n...Ouverture sur " fic "...ok \n"))(princ)
(if (setq dbx (ouvrir_dessin_dbx1 (strcat rep "\\" fic)))
   (progn
;;;---for each du dossier des modèles choisis
      (foreach f (vl-directory-files dir "*.dwg" 0)
         (vlax-for blk (vla-get-blocks dbx)
            (if (and (= (vla-get-isxref blk) :vlax-false)
                     (= (vla-get-islayout blk) :vlax-false)
                     (= (vla-get-name blk) (vl-filename-base f))
                )
(progn
                                      (setq fichier1 (strcat dir f))
 
(progn
(setq sp1 (vla-get-ModelSpace dbx))
 
(setq obj1 (vla-InsertBlock
sp1
(vlax-3d-point '(0 0 0))
fichier1
1
1
1
0
))
(vla-delete obj1)
)
)
 )))
(princ (strcat "\n...Sauvegarde sur " fic "...ok \n"))(princ)
                         (vla-saveas dbx (strcat rep "\\" fic))
                          (vlax-release-object dbx)
                              ) 
                            ) 
                         )   
                      )
                        )
                      )
  )

[jack-ft]

Ce serait bien (pour toi comme pour ceux qui lisent ton code) que tu apprennes à l'indenter correctement!

Avec emacs, tu ouvres le fichier dans le bon mode (M-x lisp-mode RET (si pas déjà fait)), tu sélectionnes tout (C-x h) et tu inventes (TAB)

Avec d'autres éditeurs, il y a souvent une solution (menu > source > indent)

[GANDHIHP]

Pour répondre à Jack-ft voici le code avec une meilleur forme :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
 
;***********************************************************
;***********************************************************
;***************** TEST ************************************
 
(vl-load-com)
 
(defun folderbox1 (message / sh folder result)
(setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application"))
(setq folder (vlax-invoke-method sh 'browseforfolder 0 message 0))
(vlax-release-object sh)
    (if folder
        (progn (setq result (vlax-get-property (vlax-get-property folder 'self) 'path))
            (if (wcmatch result "*\\")
            result
            (strcat result "\\")
            )
        )
    )
)
 
 
(defun Ouvrir_dessin_dbx1 (dwg / dbx)
    (if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
        (setq dbx (vlax-create-object "ObjectDBX.AxDbDocument"))
        (setq dbx (vlax-create-object (strcat "ObjectDBX.AxDbDocument." (substr (getvar "ACADVER") 1 2))))
    )
(vla-open dbx dwg)dbx
)
 
 
 
(defun c:test ( / dir files f b )
;;;---diallogbx
(if (setq dir (folderbox1 "Selectionner un dossier avec des gabarits")
            files (vl-directory-files dir "*.dwg" 1)
    )
    (progn
        (foreach f files 
            (if (tblsearch "block" (setq b (vl-filename-base f)))
                (progn
                    (setq fichier2 (strcat dir "\\" f))
                    (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
                    (setq mspace2 (vla-get-modelspace thisdrawing))
                    (setq obj2 (vla-InsertBlock mspace2 (vlax-3d-point '(0 0 0)) fichier2 1 1 1 0))
                (vla-delete obj2)
                )
            )
        )
(princ (strcat "\n...Dessin courant...ok (!) actualiser avec regen"  "\n"))(princ)
    )
)
;;;---liste des dessins du repertoire
    (setq rep (substr (getvar "dwgprefix") 1 (1- (strlen (getvar "dwgprefix")))))
    (if (setq lst (vl-directory-files rep "*.dwg" 1))
      (progn
        (and (eq (strcase rep) (strcase (substr (getvar "dwgprefix") 1 (1- (strlen (getvar "dwgprefix"))))))
          (setq lst (vl-remove (getvar "dwgname") lst))
        )
            (progn
     ;;;---for each liste du dossier courant
                (foreach fic lst
                (princ (strcat "\n...Ouverture sur " fic "...ok \n"))(princ)
                    (if (setq dbx (ouvrir_dessin_dbx1 (strcat rep "\\" fic)))
                         (progn
                         ;;;---for each du dossier des modèles choisis
                            (foreach f (vl-directory-files dir "*.dwg" 0)
                                (vlax-for blk (vla-get-blocks dbx)
                                    (if (and (= (vla-get-isxref blk) :vlax-false)
                                         (= (vla-get-islayout blk) :vlax-false)
                                        (= (vla-get-name blk) (vl-filename-base f))
                                         )
                                        (progn
                                            (setq fichier1 (strcat dir f))
                                            (progn
                                                (setq sp1 (vla-get-ModelSpace dbx))
                                                (setq obj1 (vla-InsertBlock sp1 (vlax-3d-point '(0 0 0)) fichier1 1 1 1 0))
                                                (vla-delete obj1)
                                            )
                                        )
                                    )
                                )
                            )
                         (princ (strcat "\n...Sauvegarde sur " fic "...ok \n"))(princ)
                         (vla-saveas dbx (strcat rep "\\" fic))
                         (vlax-release-object dbx)
                        )
                    )
                )
            )
        )
    )
)

[mika63720]

bonjour à tous
est-il possible de modifier ce code pour ne pas avoir de boite de dialogue mais de renvoyer un un répertoire pour les fichiers gabarit ?
Cordialement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
;***********************************************************
;***********************************************************
;***************** TEST ************************************
 
(vl-load-com)
 
(defun folderbox1 (message / sh folder result)
(setq sh (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application"))
(setq folder (vlax-invoke-method sh 'browseforfolder 0 message 0))
(vlax-release-object sh)
    (if folder
        (progn (setq result (vlax-get-property (vlax-get-property folder 'self) 'path))
            (if (wcmatch result "*\\")
            result
            (strcat result "\\")
            )
        )
    )
)
 
 
(defun Ouvrir_dessin_dbx1 (dwg / dbx)
    (if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
        (setq dbx (vlax-create-object "ObjectDBX.AxDbDocument"))
        (setq dbx (vlax-create-object (strcat "ObjectDBX.AxDbDocument." (substr (getvar "ACADVER") 1 2))))
    )
(vla-open dbx dwg)dbx
)
 
 
 
(defun c:test ( / dir files f b )
;;;---diallogbx
(if (setq dir (folderbox1 "Selectionner un dossier avec des gabarits")
            files (vl-directory-files dir "*.dwg" 1)
    )
    (progn
        (foreach f files 
            (if (tblsearch "block" (setq b (vl-filename-base f)))
                (progn
                    (setq fichier2 (strcat dir "\\" f))
                    (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
                    (setq mspace2 (vla-get-modelspace thisdrawing))
                    (setq obj2 (vla-InsertBlock mspace2 (vlax-3d-point '(0 0 0)) fichier2 1 1 1 0))
                (vla-delete obj2)
                )
            )
        )
(princ (strcat "\n...Dessin courant...ok (!) actualiser avec regen"  "\n"))(princ)
    )
)
;;;---liste des dessins du repertoire
    (setq rep (substr (getvar "dwgprefix") 1 (1- (strlen (getvar "dwgprefix")))))
    (if (setq lst (vl-directory-files rep "*.dwg" 1))
      (progn
        (and (eq (strcase rep) (strcase (substr (getvar "dwgprefix") 1 (1- (strlen (getvar "dwgprefix"))))))
          (setq lst (vl-remove (getvar "dwgname") lst))
        )
            (progn
     ;;;---for each liste du dossier courant
                (foreach fic lst
                (princ (strcat "\n...Ouverture sur " fic "...ok \n"))(princ)
                    (if (setq dbx (ouvrir_dessin_dbx1 (strcat rep "\\" fic)))
                         (progn
                         ;;;---for each du dossier des modèles choisis
                            (foreach f (vl-directory-files dir "*.dwg" 0)
                                (vlax-for blk (vla-get-blocks dbx)
                                    (if (and (= (vla-get-isxref blk) :vlax-false)
                                         (= (vla-get-islayout blk) :vlax-false)
                                        (= (vla-get-name blk) (vl-filename-base f))
                                         )
                                        (progn
                                            (setq fichier1 (strcat dir f))
                                            (progn
                                                (setq sp1 (vla-get-ModelSpace dbx))
                                                (setq obj1 (vla-InsertBlock sp1 (vlax-3d-point '(0 0 0)) fichier1 1 1 1 0))
                                                (vla-delete obj1)
                                            )
                                        )
                                    )
                                )
                            )
                         (princ (strcat "\n...Sauvegarde sur " fic "...ok \n"))(princ)
                         (vla-saveas dbx (strcat rep "\\" fic))
                         (vlax-release-object dbx)
                        )
                    )
                )
            )
        )
    )
)

[GANDHIHP]

Bonjour, voici le code modifié pour actualiser les dessins du dossier courant (fichier ouvert) avec un chemin personnalisé sans boite de dialogue :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
 
(vl-load-com)
 
(defun folderbox1 (message / sh folder result)
;remplacer ce chemin de vos gabarits par le votre
(setq folder "Z:\\Desktop\\Bureau\\Trav\\")
)
 
(defun Ouvrir_dessin_dbx1 (dwg / dbx)
    (if (< (atoi (substr (getvar "ACADVER") 1 2)) 16)
        (setq dbx (vlax-create-object "ObjectDBX.AxDbDocument"))
        (setq dbx (vlax-create-object (strcat "ObjectDBX.AxDbDocument." (substr (getvar "ACADVER") 1 2))))
    )
(vla-open dbx dwg)dbx
)
 
(defun c:test ( / dir files f b )
    (if (setq dir (folderbox1 "")
                files (vl-directory-files dir "*.dwg" 1)
        )
        (progn
        ;application au dessin courant
            (foreach f files 
                (if (tblsearch "block" (setq b (vl-filename-base f)))
                    (progn
                        (setq fichier2 (strcat dir "\\" f))
                        (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
                        (setq mspace2 (vla-get-modelspace thisdrawing))
                        (setq obj2 (vla-InsertBlock mspace2 (vlax-3d-point '(0 0 0)) fichier2 1 1 1 0))
                    (vla-delete obj2)
                    )
                )
            )
            (princ (strcat "\n...Dessin courant...ok (!) actualiser avec attsync"  "\n"))(princ)
        )
    )
 
 
;liste des dessins du repertoire
    (setq rep (substr (getvar "dwgprefix") 1 (1- (strlen (getvar "dwgprefix")))))
    (if (setq lst (vl-directory-files rep "*.dwg" 1))
      (progn
        (and (eq (strcase rep) (strcase (substr (getvar "dwgprefix") 1 (1- (strlen (getvar "dwgprefix"))))))
          (setq lst (vl-remove (getvar "dwgname") lst))
         )
        (progn
        (setq dir (folderbox1 "Selectionner un dossier avec des gabarits")
            files (vl-directory-files dir "*.dwg" 1)
        )
     ;foreach liste du dossier courant
      (foreach fic lst
                (princ (strcat "\n...Ouverture sur " fic "...ok \n"))(princ)
                    (if (setq dbx (ouvrir_dessin_dbx1 (strcat rep "\\" fic)))
                         (progn
                         ;foreach du dossier des modèles choisis
                            (foreach f (vl-directory-files dir "*.dwg" 0)
                                (vlax-for blk (vla-get-blocks dbx)
                                    (if (and (= (vla-get-isxref blk) :vlax-false)
                                         (= (vla-get-islayout blk) :vlax-false)
                                        (= (vla-get-name blk) (vl-filename-base f))
                                         )
                                        (progn
                                            (setq fichier1 (strcat dir f))
                                            (progn
                                                (setq sp1 (vla-get-ModelSpace dbx))
                                                (setq obj1 (vla-InsertBlock sp1 (vlax-3d-point '(0 0 0)) fichier1 1 1 1 0))
                                                (vla-delete obj1)
                                            )
                                        )
                                    )
                                )
                            )
                         (princ (strcat "\n...Sauvegarde sur " fic "...ok \n"))(princ)
                         (vla-saveas dbx (strcat rep "\\" fic))
                         (vlax-release-object dbx)
                        )
                    )
                )
            )
        )
    )
)

cordialement
Gandhihp

[mika63720]

Merci beaucoup
le code marche nickel
cordialement