x13

Merçci beaucoup d'avoir répondu rapidement. Merçci a Bonuscad pour son programme qui fonctionne très bien. Par contre j'aimerais que la valeur du segment en X soit constant soit 12 ou 250 et que ce soit la valeur du segment en Y qui soit variable. Exemple 4/12, 6/12, 8.5/12 ou 142/250, 121.65/250 etc. La constante 12 est utilisée pour les pentes de toit, tandis que la constante 250 est utilisée pour représenter la pente des éléments de dessin d'atelier de charpente d'acier. Merçci. Françcois

J'aimerais modifier un petit programme afin qu'il fonctionne autant en métrique (mm) qu'en impérial (pouces). Pour le fichier DCL j'ajouterais deux boutons radio, un pour activer les unités métriques et l'autre pour les unités impérials. spacer_1; : row { : boxed_radio_row { label = "Unités de dessin..."; : radio_button { label = "Pouces"; key = "unit_1";} : radio_button { label = "Millimètres"; key = "unit_2";} Pour le fichier LSP, il faudrait contrôler les valeurs de la variable DIMSCALE pour le longueur des segments du symbôle et la hauteur du texte et le décalage du symbôle p/r a la ligne en pente. Est-ce que le cheminement est correcte ou s'il y a une meilleure façcon de faire? Merçci de votre aide. Voiçi le programme en question. ; ; ; DDSLOPE.LSP 3.0 ; ; © August 1999, Greg MacGeorge ; DDSLOPE.LSP - Draw slope marks in AutoCad. ; Side (a) and Angle (A) Known ; (defun aE () (setq sidea sidea_len) (setq sidec (/ sidea (sin anga))) (setq sideb (sqrt (- (* sidec sidec) (* sidea sidea)))) ) ; ; ; Side (b) and Angle (A) Known ; ; (defun bD () (setq sideb sideb_len) (setq sidec (/ sideb (cos anga))) (setq sidea (sqrt (- (* sidec sidec) (* sideb sideb)))) ) ; ; ; ; (defun s1 () (setq p2x (+ p1x sidea_len)) (setq p2y p1y) (setq p2 (list p2x p2y)) (setq p3x p2x) (setq p3y (+ p2y sidea)) (setq p3 (list p3x p3y)) (setq p4x (+ p1x (* 0.5 sidea_len))) (setq p4y (- p1y xtxt2)) (setq p4 (list p4x p4y)) (setq p5x (+ p2x ytxt)) (setq p5y (+ p2y (* 0.5 sidea))) (setq p5 (list p5x p5y)) (setq sidea (rtos (* (/ 1 ds) 24 sidea) 5 4)) (command "line" pS p2 p3) (command "") (command "text" "c" p4 txtht 0 12) (command "text" p5 txtht 0 sidea) ) ; ; ; ; (defun s2 () (setq p2x p1x) (setq p2y (+ p1y sidea_len)) (setq p2 (list p2x p2y)) (setq p3x (+ p2x sideb)) (setq p3y p2y) (setq p3 (list p3x p3y)) (setq p4x (- p1x ytxt)) (setq p4y (+ p1y (* 0.5 sidea_len))) (setq p4 (list p4x p4y)) (setq p5x (+ p2x (* 0.5 sideb))) (setq p5y (+ p2y xtxt1)) (setq p5 (list p5x p5y)) (setq sideb (rtos (* (/ 1 ds) 24 sideb) 5 4)) (command "line" pS p2 p3) (command "") (command "text" "r" p4 txtht 0 12) (command "text" "c" p5 txtht 0 sideb) ) ; ; ; ; (defun s3 () (setq p2x p1x) (setq p2y (+ p1y sidea_len)) (setq p2 (list p2x p2y)) (setq p3x (- p2x sideb)) (setq p3y p2y) (setq p3 (list p3x p3y)) (setq p4x (+ p1x ytxt)) (setq p4y (+ p1y (* 0.5 sidea_len))) (setq p4 (list p4x p4y)) (setq p5x (- p2x (* 0.5 sideb))) (setq p5y (+ p2y xtxt1)) (setq p5 (list p5x p5y)) (setq sideb (rtos (* (/ 1 ds) 24 sideb) 5 4)) (command "line" pS p2 p3) (command "") (command "text" p4 txtht 0 12) (command "text" "c" p5 txtht 0 sideb) ) ; ; ; ; (defun s4 () (setq p2x (- p1x sidea_len)) (setq p2y p1y) (setq p2 (list p2x p2y)) (setq p3x p2x) (setq p3y (+ p2y sidea)) (setq p3 (list p3x p3y)) (setq p4x (- p1x (* 0.5 sidea_len))) (setq p4y (- p1y xtxt2)) (setq p4 (list p4x p4y)) (setq p5x (- p2x ytxt)) (setq p5y (+ p2y (* 0.5 sidea))) (setq p5 (list p5x p5y)) (setq sidea (rtos (* (/ 1 ds) 24 sidea) 5 4)) (command "line" pS p2 p3) (command "") (command "text" "c" p4 txtht 0 12) (command "text" "r" p5 txtht 0 sidea) ) ; ; ; ; (defun s5 () (setq p2x (- p1x sidea_len)) (setq p2y p1y) (setq p2 (list p2x p2y)) (setq p3x p2x) (setq p3y (- p2y sidea)) (setq p3 (list p3x p3y)) (setq p4x (- p1x (* 0.5 sidea_len))) (setq p4y (+ p1y xtxt1)) (setq p4 (list p4x p4y)) (setq p5x (- p2x ytxt)) (setq p5y (- p2y (* 0.5 sidea))) (setq p5 (list p5x p5y)) (setq sidea (rtos (* (/ 1 ds) 24 sidea) 5 4)) (command "line" pS p2 p3) (command "") (command "text" "c" p4 txtht 0 12) (command "text" "r" p5 txtht 0 sidea) ) ; ; ; ; (defun s6 () (setq p2x p1x) (setq p2y (- p1y sidea_len)) (setq p2 (list p2x p2y)) (setq p3x (- p2x sideb)) (setq p3y p2y) (setq p3 (list p3x p3y)) (setq p4x (+ p1x ytxt)) (setq p4y (- p1y (* 0.5 sidea_len))) (setq p4 (list p4x p4y)) (setq p5x (- p2x (* 0.5 sideb))) (setq p5y (- p2y xtxt2)) (setq p5 (list p5x p5y)) (setq sideb (rtos (* (/ 1 ds) 24 sideb) 5 4)) (command "line" pS p2 p3) (command "") (command "text" p4 txtht 0 12) (command "text" "c" p5 txtht 0 sideb) ) ; ; ; ; (defun s7 () (setq p2x p1x) (setq p2y (- p1y sidea_len)) (setq p2 (list p2x p2y)) (setq p3x (+ p2x sideb)) (setq p3y p2y) (setq p3 (list p3x p3y)) (setq p4x (- p1x ytxt)) (setq p4y (- p1y (* 0.5 sidea_len))) (setq p4 (list p4x p4y)) (setq p5x (+ p2x (* 0.5 sideb))) (setq p5y (- p2y xtxt2)) (setq p5 (list p5x p5y)) (setq sideb (rtos (* (/ 1 ds) 24 sideb) 5 4)) (command "line" pS p2 p3) (command "") (command "text" "r" p4 txtht 0 12) (command "text" "c" p5 txtht 0 sideb) ) ; ; ; ; (defun s8 () (setq p2x (+ p1x sidea_len)) (setq p2y p1y) (setq p2 (list p2x p2y)) (setq p3x p2x) (setq p3y (- p2y sidea)) (setq p3 (list p3x p3y)) (setq p4x (+ p1x (* 0.5 sidea_len))) (setq p4y (+ p1y xtxt1)) (setq p4 (list p4x p4y)) (setq p5x (+ p2x xtxt2)) (setq p5y (- p2y (* 0.5 sidea))) (setq p5 (list p5x p5y)) (setq sidea (rtos (* (/ 1 ds) 24 sidea) 5 4)) (command "line" pS p2 p3) (command "") (command "text" "c" p4 txtht 0 12) (command "text" p5 txtht 0 sidea) ) ; ; ; ; (defun slope-a () (setvar "cmdecho" 0) (setq cl (getvar "clayer")) (setq ds (getvar "dimscale" )) (setq st (getvar "textstyle")) (if (= lay "T") (setvar "clayer" cl) (setvar "clayer" lay) ) (if (= sty "T") (setvar "textstyle" st) (setvar "textstyle" sty) ) (setq sidea_len (* 0.5 ds)) (setq sideb_len (* 0.5 ds)) (setq txtht (* ds 0.0625)) (setq ytxt (* ds 0.125)) (setq xtxt1 (* ds 0.125)) (setq xtxt2 (+ txtht (* ds 0.125))) (setq a (entsel)) (setq b (car a)) (setq c (entget b)) (setq p1s (assoc 10 c)) (setq p1 (cdr p1s)) (setq p2s (assoc 11 c)) (setq p2 (cdr p2s)) (setq anga (angle p1 p2)) (setq an (angtos anga 0 4)) (setq an (atof an)) (setq quad1 (/ an 45)) (if (= quad1 0) (setq quad "1")) (if (and (> quad1 0) (<= quad1 1)) (setq quad "1")) (if (and (> quad1 1) (<= quad1 2)) (setq quad "2")) (if (and (> quad1 2) (<= quad1 3)) (setq quad "3")) (if (and (> quad1 3) (<= quad1 4)) (setq quad "4")) (if (and (> quad1 4) (<= quad1 5)) (setq quad "5")) (if (and (> quad1 5) (<= quad1 6)) (setq quad "6")) (if (and (> quad1 6) (<= quad1 7)) (setq quad "7")) (if (and (> quad1 7) (<= quad1 8)) (setq quad "8")) (if (= quad "0") (setq quad "1")) (if (= quad "1") (bD)) (if (= quad "2") (aE)) (if (= quad "3") (aE)) (if (= quad "4") (bD)) (if (= quad "5") (bD)) (if (= quad "6") (aE)) (if (= quad "7") (aE)) (if (= quad "8") (bD)) (setq pS (getpoint "Sélectionnez point de départ du symbole: ")) (setq p1x (car pS)) (setq p1y (cadr pS)) (if (= quad "1") (s5)) (if (= quad "2") (s2)) (if (= quad "3") (s3)) (if (= quad "4") (s8)) (if (= quad "5") (s5)) (if (= quad "6") (s2)) (if (= quad "7") (s3)) (if (= quad "8") (s8)) ) ; ; ; ; (defun slope-b () (setvar "cmdecho" 0) (setq cl (getvar "clayer")) (setq ds (getvar "dimscale" )) (setq st (getvar "textstyle")) (if (= lay "T") (setvar "clayer" cl) (setvar "clayer" lay) ) (if (= sty "T") (setvar "textstyle" st) (setvar "textstyle" sty) ) (setq sidea_len (* 0.5 ds)) (setq sideb_len (* 0.5 ds)) (setq txtht (* ds 0.0625)) (setq ytxt (* ds 0.125)) (setq xtxt1 (* ds 0.125)) (setq xtxt2 (+ txtht (* ds 0.125))) (setq a (entsel)) (setq b (car a)) (setq c (entget b)) (setq p1s (assoc 10 c)) (setq p1 (cdr p1s)) (setq p2s (assoc 11 c)) (setq p2 (cdr p2s)) (setq anga (angle p1 p2)) (setq an (angtos anga 0 4)) (setq an (atof an)) (setq quad1 (/ an 45)) (if (= quad1 0) (setq quad "1")) (if (and (> quad1 0) (<= quad1 1)) (setq quad "1")) (if (and (> quad1 1) (<= quad1 2)) (setq quad "2")) (if (and (> quad1 2) (<= quad1 3)) (setq quad "3")) (if (and (> quad1 3) (<= quad1 4)) (setq quad "4")) (if (and (> quad1 4) (<= quad1 5)) (setq quad "5")) (if (and (> quad1 5) (<= quad1 6)) (setq quad "6")) (if (and (> quad1 6) (<= quad1 7)) (setq quad "7")) (if (and (> quad1 7) (<= quad1 8)) (setq quad "8")) (if (= quad "1") (bD)) (if (= quad "2") (aE)) (if (= quad "3") (aE)) (if (= quad "4") (bD)) (if (= quad "5") (bD)) (if (= quad "6") (aE)) (if (= quad "7") (aE)) (if (= quad "8") (bD)) (setq pS (getpoint "Selectionnez Point de départ du symbole: ")) (setq p1x (car pS)) (setq p1y (cadr pS)) (if (= quad "1") (s1)) (if (= quad "2") (s6)) (if (= quad "3") (s7)) (if (= quad "4") (s4)) (if (= quad "5") (s1)) (if (= quad "6") (s6)) (if (= quad "7") (s7)) (if (= quad "8") (s4)) ) ; ; ; (defun set_view () (if (= vw 1) (progn (setq x (dimx_tile "image") y (dimy_tile "image")) (start_image "image") (fill_image 0 0 x y 0) (slide_image 0 0 x y "ddslope1") (end_image))) (if (= vw 2) (progn (setq x (dimx_tile "image") y (dimy_tile "image")) (start_image "image") (fill_image 0 0 x y 0) (slide_image 0 0 x y "ddslope2") (end_image))) ) ; ; ; (defun set_tbl_list () (setq elist (tblnext "layer" 1)) (setq code 2) (setq lay_count 0) (if (not (or (= (cdr (assoc 70 elist)) 65) (= (cdr (assoc 70 elist)) 69))) (setq tbl_list (list (cdr (assoc code elist)))) (setq lay_count (+ lay_count 1)) ) ;(setq tbl_list (list (dxf_list 2 (tblnext "layer" 1)))) (while (setq t (tblnext "layer")) (if (not (or (= (cdr (assoc 70 t)) 65) (= (cdr (assoc 70 t)) 69))) (setq tbl_list (cons (cdr (assoc code t)) tbl_list)) (setq lay_count (+ lay_count 1)) ) ;(setq tbl_list (cons (dxf_list 2 t) tbl_list)) ) (setq tbl_list (reverse tbl_list)) (start_list "la_list") (mapcar 'add_list tbl_list) (end_list) (setq lay_count (strcat (rtos lay_count 2 0) " calques sont gelés")) (set_tile "message" lay_count) ) ; ; ; (defun set_lay () (setq count lay_draw) (setq tbl_list2 tbl_list) (if (= count 0) (setq lay (car tbl_list2))) (while (> count 0) (setq tbl_list2 (cdr tbl_list2)) (setq lay (car tbl_list2)) (setq count (- count 1)) ) ) ; ; ; (defun set_style_list () (setq elist (tblnext "style" 1)) (setq code 2) (setq style_count 0) (if (not (or (= (cdr (assoc 70 elist)) 65) (= (cdr (assoc 70 elist)) 69))) (setq st_tbl_list (list (cdr (assoc code elist)))) (setq style_count (+ style_count 1)) ) ;(setq tbl_list (list (dxf_list 2 (tblnext "style" 1)))) (while (setq t (tblnext "style")) (if (not (or (= (cdr (assoc 70 t)) 65) (= (cdr (assoc 70 t)) 69))) (setq st_tbl_list (cons (cdr (assoc code t)) st_tbl_list)) (setq style_count (+ style_count 1)) ) ;(setq tbl_list (cons (dxf_list 2 t) tbl_list)) ) (setq st_tbl_list (reverse st_tbl_list)) (start_list "st_list") (mapcar 'add_list st_tbl_list) (end_list) ) ; ; ; (defun set_style () (setq count sty_draw) (setq tbl_list3 st_tbl_list) (if (= count 0) (setq sty (car tbl_list3))) (while (> count 0) (setq tbl_list3 (cdr tbl_list3)) (setq sty (car tbl_list3)) (setq count (- count 1)) ) ) ; ; ; (defun c:ddslope () (setq OLDERR *ERROR* *ERROR* DDSLOPE_ERR) ;_ end of setq (setq OS (getvar "OSMODE")) (setvar "cmdecho" 0) (setq dcl_id (load_dialog "ddslope.dcl")) (if (not (new_dialog "slope" dcl_id)) (exit)) (setq x (dimx_tile "image") y (dimy_tile "image")) (start_image "image") (fill_image 0 0 x y 0) (slide_image 0 0 x y "ddslope1") (end_image) (setq vw 1) (setq lay "T") (setq sty "T") (mode_tile "aline" 2) (set_tbl_list) (set_style_list) (action_tile "la_list" "(setq lay_draw (atoi $value)) (set_lay)") (action_tile "st_list" "(setq sty_draw (atoi $value)) (set_style)") (action_tile "aline" "(setq vw 1) (set_view)") (action_tile "bline" "(setq vw 2) (set_view)") (action_tile "accept" "(done_dialog)") (action_tile "cancel" "(done_dialog)") (start_dialog) (unload_dialog dcl_id) (if (= vw 1) (slope-a)) (if (= vw 2) (slope-b)) (setvar "clayer" cl) (setvar "textstyle" st) (princ) ) ; ; ; (princ "DDSLOPE 3.0 © Greg MacGeorge, 1999....chargé.") (terpri) (princ "C:DDSLOPE") (print) ; // // DDSLOPE.DCL 3.0 // // © August 1999, Greg MacGeorge // DDSLOPE.DCL - Used to get input for the DDSLOPE.LSP program. dcl_settings : default_dcl_settings { audit_level = 0; } slope : dialog { label = "SYMBOLES DE PENTE"; :column { :image { key = "image"; width = 20; aspect_ratio = 0.90; } : row { :text {label = "Calque:";} :popup_list { key = "la_list"; fixed_width; } } :row { :text {label = "Style:";} :popup_list { key = "st_list"; fixed_width; } } } spacer_1; : boxed_column { label = "Localisation symbôle de pente"; :radio_button { key = "aline"; label = "Au dessus de la pente: "; } :radio_button { key = "bline"; label = "Sous la pente:"; } } spacer_1; : boxed_row { label = "Messages"; : text { key = "message"; fixed_width; } } :row {ok_button; cancel_button;} } // //

Merçci a Éric etOli553. Rien sur le lien de Oli553 par contre ceux de Éric devraient fonctionner. Je réinstalle et vous reviens avec le résultat.

Je cherche le pilote Sentinel-Rainbow "dernier cri" ... vs 5.41.1 pour permettrre le fonctionnement de Autocad2000 sous Win XP tel que déjèa expliqué par Lecrabe. Quelqu'un pourrait-il me le transmettre par courriel. Merçci. estb@globetrotter.net

Bonjour, Est-ce que ta cartouche est déjà crée! Si non, soit tu crée ton propre cartouche, soit tu utilise celles proposé par AutoCad (fichier .dwt) et tu les modifie à ta guise (presentation, attributs etc.) Ensuite tu procède comme suit:. TRANSFERT D'UN DESSIN DE L'ESPACE OBJET À L'ESPACE PAPIER (onglet présentation) 1.) Sélectionnez l'onglet présentation "layout" (Espace papier) 2.) Effacer la fenêtre qui a été générée automatiqement lors du basculement de l'espace objet à l'espace papier. 3.) Insérer votre gabarit (menu insérer-> bloc-> rechercher->choisir le répertoire puis le bloc désiré->double clic gauche ->positionner le bloc ->entrée. Alternative: insérer le gabarit à l'aide du programme "Coversheet" ou "Alsetup" 4.) Faire zomm étendu à partir de la barre d'outils standards, pour permettre d'adapter l'affichage écran aux nouvelles valeurs des limites. 5.) À la ligne de commande taper MVIEW puis ENTRÉE pour transférer le dessin de l'espace objet à l'espace papier. Faites un ZOOM FENÊTRE excluant la cartouche pour déterminer l'espace réservé au dessin à l'intérieur du gabarit. 6.) Clic droit sur l'onglet présentation, choisir Page setup (Configuration de tracé). Propriété d'imprimante (Plot device) -Déterminer le format de papier -Déterminer l'orientation du papier "landscape" -Déterminer l'échelle de tracé (d'impression), utiliser Ajuster au format (plot to scale) si le format de papier ne correspond pas au format de gabarit. -Déterminer la surface d'impression (plot area) ->ÉTENDU -Déterminer le décalage d'impression (plot offset) -> CENTRÉ (center to plot) -Déterminer la surface à imprimer ->FENÊTRE (window), sélectionner les deux limites opposés du gabarit ->OK -> ENTRÉE. 7.) Déterminer l'échelle du dessin; sur la ligne de commande taper MVSETUP puis E pour échelle ou S pour scale. Sélectionner le cadre de la métavue, entrer le nombre d'unités de l'espace papier soit 1. Entrer le nombre d'unités de l'espace objet, exemple 100 pour une échelle de 1=100. Faites ENTRÉE, ENTRÉE. 8.) Faites un PAN pour placer le dessin dans la fenêtre. 9.) Verrouiller la fenêtre afin de pouvoir Zoomer celle-ci. - sélectionner le cadre de la fenêtre, activer une des poignées, clic droit et choisir propriétés; la boîte de dialogue ouvre , aller à affichage verrouillé (display locked)et avec la barre de défilement choisir OUI (yes). fermer la boîte de dialogue et faites 2 fois échappe pour fermer la procédure. Vous pouvez également à l'aide d'un bouton activer la macro suivante: ^C^C-LA;T;VPORT;;-vport;l;on;all;; 10.) Cotation dans l'ESPACE PAPIER: -Barre d'outil COTATION, à l'aide de la barre de défilement du contrôle de style de cote, vérifier la disponibilité du style de cote désiré.S'il n'existe pas, il faut créer le nouveau style de cote. -Création du nouveau style de cote: Cliquer sur l'icône STYLE DE COTE (dim style)->ouverture de la boîte de dialogue GESTIONNAIRE STYLE DE COTE-> NOUVEAU-> nommer le nouveau style de cote ex. ESTB25 et cliquer sur CONTINUE-> ouverture de la boîte de dialogue NOUVEAU STYLE DE COTE-> onglet UNITÉS PRIMAIRES -> FACTEUR D'ÉCHELLE inscrire 25-> OK -> FERMER Votre style de cote pour une echelle de 1=25 est cree. Bon travail, François

Salut l'ACADDIEN, Il me manque ton courriel.

Effectivement, il y a des standards pour l'utilisations des calques en regard de leurs couleurs, type de ligne et épaisseurs de traits. L'American institue of Achitect a publié son premier guide en 1990 intitulé "AIALayerguide". Rodders Computer-Aided Solutions, Ottawa, Ontario, Canada a créé plus de 800 standards pour le gouvernement canadien. http://www.rodders.com/cad/rcas_desktop2.html IL y a aussi les standars duRoyaume-uni British Standards Institution's BS 1192-5 et les standards internationnaux (ISO 13567-1, 13567-2, and 13567-3) . J'ai traduit une bonne partie des standars de l'AIA et certains du gouvernement canadien. Pour ceux que cela intéresse, envoyé moi un message privé avec votre adresse de courriel. :D

Voiçi quelques sites contenant de tutoriels. http://aidacad.com/fr/autocad.htm http://www.afralisp.com/tutor.htm http://www.gr-acad.arq.br/paginas/dup.htm http://pages.infinit.net/miket/acad.html http://www.gregmacg.com/ http://www.hyperpics.com/cad/AutoCAD/autocad_windows.htm http://come.to/autolisppage http://klobouk.fsv.cvut.cz/~chour/ salut, François

Celui-ci fonctionne bien, ;;; ========================================================================== ;;; File : PLOTALL.LSP ;;; Purpose : Provides PLOTALL and -PLOTALL commands to plot all paper space ;;; layouts in the current drawing, thereby working around the ;;; "Layout of order" item in January 2003 Bug Watch. ;;; Author : Steve Johnson for Cadalyst magazine. ;;; Notes : Expects to find PLOTALL.DCL in search path. ;;; Uses AutoCAD 2000+ Visual LISP functions. ;;; Only tested on AutoCAD 2000 and 2002. ;;; ========================================================================== ;; --------------------------------------------------------------------------- ;; Function: C:PLOTALL ;; Purpose : Dialogue box version of command to plot all paper space layouts ;; in the current drawing. ;; Global : PLOTALL-DEVICE: string containing name of plot device, e.g. ;; "\\\\server\\plotter" or ;; "plotter.pc3" ;; PLOTALL-QTY: number of each layout to plot ;; PLOTALL-ORDER: order in which to plot (string) ;; PLOTALL-REV: reverse order? (boolean: T = reverse) ;; Local : dclfile: full filename of "PlotAll.dcl" file ;; dcl#: DCL ID number ;; device-list: list of available plot devices ;; order-list: list of order strings ;; device#: index number of chosen device in device-list ;; order#: index number of chosen order in order-list ;; quantity: temporary number of each layout to plot ;; --------------------------------------------------------------------------- (defun C:PLOTALL (/ ; Functions init_vars init_tiles call_ok ; Variables dclfile dcl# device-list order-list device# order# quantity ) ;; --------------------------------------------------------------------------- ;; Function: init_vars ;; Purpose : Sets up variables prior to invoking dialogue box. ;; --------------------------------------------------------------------------- (defun init_vars () (if (not PLOTALL-DEVICE) (setq PLOTALL-DEVICE "None")) (if (not PLOTALL-QTY) (setq PLOTALL-QTY 1)) (if (not PLOTALL-ORDER) (setq PLOTALL-ORDER "Alpha")) (setq device-list (plotall_device_list) order-list '("Alpha" "Numeric" "Tab") order# (- (length order-list) (length (member PLOTALL-ORDER order-list))) quantity PLOTALL-QTY ) (if (and PLOTALL-DEVICE (member PLOTALL-DEVICE device-list)) (setq device# (- (length device-list) (length (member PLOTALL-DEVICE device-list))) ) (setq device# 0) ) ) ; End init_vars ;; --------------------------------------------------------------------------- ;; Function: init_tiles ;; Purpose : Sets up dialogue box tiles prior to invoking dialogue box. ;; --------------------------------------------------------------------------- (defun init_tiles () (action_tile "accept" "(call_ok)") (start_list "device_list") (foreach one device-list (add_list one) ) (end_list) (start_list "order_list") (foreach one order-list (add_list one) ) (end_list) (set_tile "device_list" (itoa device#)) (set_tile "order_list" (itoa order#)) (set_tile "reverse" (if PLOTALL-REV "1" "0")) (set_tile "quantity" (itoa quantity)) ) ; End init_tiles ;; --------------------------------------------------------------------------- ;; Function: call_ok ;; Purpose : Callback function for OK button. Ensures a quantity greater than ;; 0 and a device other than "None". ;; --------------------------------------------------------------------------- (defun call_ok () (if (> (setq quantity (atoi (get_tile "quantity"))) 0) (if (> (setq device# (atoi (get_tile "device_list"))) 0) (progn (setq PLOTALL-DEVICE (nth device# device-list) PLOTALL-ORDER (nth (atoi (get_tile "order_list")) order-list) PLOTALL-REV (= (get_tile "reverse") "1") PLOTALL-QTY quantity ) (done_dialog 1) ) (set_tile "error" "Vous devez choisir un modèle d'imprimante ou de traceur") ) (set_tile "error" "Quantité doit être 1 ou plus") ) ) ; End call_ok ;; Start C:PLOTALL ----------------------------------------------------------- (cond ((not (findfile (setq dclfile "PlotAll.dcl"))) (alert "Cannot find PlotAll.dcl") ) ((< (setq dcl# (load_dialog dclfile)) 0) ; Error (prompt (strcat "\nCannot load " dclfile ".")) ) ((not (new_dialog "plotall_main" dcl#)) ; Error (prompt (strcat "\nProblem with " dclfile ".")) ) (T ; No DCL problems: fire it up (init_vars) (init_tiles) (setq action (start_dialog)) (unload_dialog dcl#) (if (= action 1) (plotall_layouts PLOTALL-DEVICE PLOTALL-QTY PLOTALL-ORDER PLOTALL-REV) ) ) ) (princ) ) ; End C:PLOTALL ;; --------------------------------------------------------------------------- ;; Function: C:-PLOTALL ;; Purpose : Command line version of command to plot all paper space layouts ;; in the current drawing. ;; Global : PLOTALL-DEVICE: string containing name of plot device ;; PLOTALL-QTY: number of each layout to plot ;; PLOTALL-ORDER: order in which to plot (string) ;; PLOTALL-REV: reverse order? (boolean: T = reverse) ;; Local : device: temporary string containing name of plot device ;; device-list: list of available plot devices ;; order: temporary order in which to plot (string) ;; rev: temporary reverse order? (boolean: T = reverse) ;; quantity: temporary number of each layout to plot ;; --------------------------------------------------------------------------- (defun C:-PLOTALL (/ device device-list order rev quantity) (if (not PLOTALL-DEVICE) (setq PLOTALL-DEVICE "None")) (if (not PLOTALL-QTY) (setq PLOTALL-QTY 1)) (if (not PLOTALL-ORDER) (setq PLOTALL-ORDER "Alpha")) (setq device (getstring T (strcat "\nPlot device <" PLOTALL-DEVICE ">: "))) (if (= device "") (setq device PLOTALL-DEVICE)) (cond ((= device "None") (prompt "\nMust specify a plot device.") ) ((not (member (strcase device) (mapcar 'strcase (setq device-list (plotall_device_list))) ) ) (foreach one device-list (if (/= one "None") (prompt (strcat one "\n")) ) ) (prompt "Must specify one of the above plot devices.\n") ) (progn (initget "Alpha Numeric Tab") (setq order (getkword (strcat "\nImprime selon un Ordre [Alphabéthique/Numerique/Tab] <" PLOTALL-ORDER ">: " ) ) ) (if order (setq PLOTALL-ORDER order)) (initget "Yes No") (setq rev (getkword (strcat "\nOrdre inverse [Yes/No] <" (if PLOTALL-REV "Yes" "No") ">: " ) ) ) (if rev (setq PLOTALL-REV (= rev "Yes"))) (initget 6) ; Positive integer (setq PLOTALL-DEVICE device quantity (getint (strcat "\nNombre de copies <" (itoa PLOTALL-QTY) ">: ")) ) (if quantity (setq PLOTALL-QTY quantity)) (plotall_layouts PLOTALL-DEVICE PLOTALL-QTY PLOTALL-ORDER PLOTALL-REV) ) ) (princ) ) ; End C:-PLOTALL ;; --------------------------------------------------------------------------- ;; Function: plotall_device_list ;; Purpose : Returns list of strings of all available plot devices. ;; Local : curdwg: current drawing object ;; pslayout: paper space layout object ;; --------------------------------------------------------------------------- (defun plotall_device_list (/ curdwg pslayout) (vl-load-com) (setq curdwg (vla-get-ActiveDocument (vlax-get-Acad-Object)) pslayout (vla-get-Layout (vla-get-PaperSpace curdwg)) ) ; Call RefreshPlotDeviceInfo before GetPlotDeviceNames (vla-RefreshPlotDeviceInfo pslayout) (vlax-safearray->list (vlax-variant-value (vla-GetPlotDeviceNames pslayout))) ) ; End plotall_device_list ;; --------------------------------------------------------------------------- ;; Function: plotall_layouts ;; Purpose : Plots all paper space layouts in current drawing to a specified ;; plot device, in the specified quantity. ;; Params : DEVICE: string containing name of plot device ;; QTY: number of each layout to plot ;; ORDER: order in which to plot ("Alpha" "Numeric" "Tab") ;; REV: boolean: if T, reverse plot order ;; Local : curdwg: current drawing object ;; layout-array: safearray of a single layout name string ;; layout-list: list of layout name strings ;; plot: plot object (needed to actually perform plot) ;; errmsg: returned object from failed plot attempt ;; --------------------------------------------------------------------------- (defun plotall_layouts (DEVICE QTY ORDER REV / ; Functions delnth sortlist str_num_sort tab_sort ; Variables curdwg layout-array layout-list plot errmsg) ;; --------------------------------------------------------------------------- ;; Function: delnth ;; Purpose : Returns a list with the Nth item deleted ;; Params : N: index number of item to delete (0 is first item in list) ;; LST: list to delete from ;; Local : #: item counter ;; tlst: temporary list ;; --------------------------------------------------------------------------- (defun delnth (N LST / # tlst) (setq # 0) (while (and LST (/= # N)) (setq tlst (cons (car LST) tlst) LST (cdr LST) # (1+ #) ) ) (reverse (append (reverse (cdr LST)) tlst)) ) ; End delnth ;; --------------------------------------------------------------------------- ;; Function: sortlist ;; Purpose : Sorts a list, allowing any function to be used for item comparison. ;; Params : LST: list to sort ;; FUN: name of function to apply to test for "lower": could be a ;; built-in function (e.g. >) or a user defined function, ;; possibly defined on the spot using lambda. ;; --------------------------------------------------------------------------- (defun sortlist (LST FUN / size # pos high item tmplst) (repeat (1- (setq size (length LST))) (setq # 1 ; Position of 1st item to compare with highest item pos 0 ; Position of initial highest item high (nth 0 LST) ; Value of initial highest item ) (while (< # size) ; Walk through the whole list, finding the highest item (if (apply FUN (list high (setq item (nth # LST)))) ; Test for higher (setq ; Found a higher item, so record its: high item ; value, pos # ; position ) ) (setq # (1+ #)) ; Test next item ) (setq tmplst (cons high tmplst) ; Stick highest item at start of temp list LST (delnth pos LST) ; Delete highest item from main list, size (- size 1) ; and reduce size of main list ) ) (cons (car LST) tmplst) ; Add last (lowest) item to start and return ) ; End sortlist ;; --------------------------------------------------------------------------- ;; Function: str_num_sort ;; Purpose : Sorts a list of layouts into tab number order. ;; Params : LST: list of sublists to sort. Each sublist contains a tab ;; number index integer and a layout name string. ;; --------------------------------------------------------------------------- (defun str_num_sort (LST / split_str_num str_num_compare) ;; --------------------------------------------------------------------------- ;; Function: split_str_num ;; Purpose : Divides a string into 3 parts: string prefix, numeric middle and ;; string suffix. ;; Params : STR: string to split ;; Local : #: loop counter/character index ;; ch: current character ;; slen: string length ;; s1: string prefix ;; s2: string containing numeric middle ;; s3: string prefix ;; Returns : Always a list containing a string, a real and a string. If any of ;; these elements do not exist, defaults of "", 0.0 and "" are used. ;; --------------------------------------------------------------------------- (defun split_str_num (STR / # ch slen s1 s2 s3) (setq # 0 slen (strlen STR) s1 "" ) (while (and (<= (setq # (1+ #)) slen) (not s3)) (if (wcmatch (setq ch (substr STR # 1)) "[0123456789.]") (if s2 (setq s2 (strcat s2 ch)) (setq s2 ch) ) (if s2 (setq s3 (substr STR # 1)) (setq s1 (strcat s1 ch)) ) ) ) (list s1 (if s2 (atof s2) 0.0) (if s3 s3 "")) ) ; End split_str_num ;; --------------------------------------------------------------------------- ;; Function: str_num_compare ;; Purpose : Compares 2 lists. Each list contains a tab number index integer ;; and a layout name string. The tab number is ignored and the ;; layout name string is divided into 3 parts: string prefix, ;; numeric middle and string suffix. The comparison is then performed ;; on the first then second, then third items, then on the string as ;; a whole. ;; Params : X, Y: lists to compare ;; Local : xlist: list of 3 parts derived from X layout name string ;; ylist: list of 3 parts derived from Y layout name string ;; Returns : T if X < Y, else nil. ;; --------------------------------------------------------------------------- (defun str_num_compare (X Y / xlist ylist) (setq xlist (split_str_num (cadr X)) ylist (split_str_num (cadr Y)) ) (if (= (car xlist) (car ylist)) ; if 1st are equal (if (= (cadr xlist) (cadr ylist)) ; if 2nd are equal (if (= (caddr xlist) (caddr ylist)) ; if 3rd are equal (< (cadr X) (cadr Y)) ; then ascending on whole string (< (caddr xlist) (caddr ylist)) ; else ascending on 3rd ) (< (cadr xlist) (cadr ylist)) ; else ascending on 2nd ) (< (car xlist) (car ylist)) ; else ascending on 1st ) ) ; End str_num_compare ;; Start str_num_sort -------------------------------------------------------- (reverse (sortlist LST 'str_num_compare)) ) ; End str_num_sort ;; --------------------------------------------------------------------------- ;; Function: tab_sort ;; Purpose : Sorts a list of layouts into tab number order. ;; Params : LST: list of sublists to sort. Each sublist contains a tab ;; number index integer and a layout name string. ;; Local : #: index integer counter ;; retlst: sorted list to return ;; --------------------------------------------------------------------------- (defun tab_sort (LST / # retlst) (setq # 1) (while (< (length retlst) (length LST)) (foreach one LST (if (= (car one) #) (setq retlst (cons one retlst) # (1+ #) ) ) ) ) retlst ) ; End tab_sort ;; Start plotall_layouts ----------------------------------------------------- (vl-load-com) (setq curdwg (vla-get-ActiveDocument (vlax-get-Acad-Object)) layout-array (vlax-make-safearray vlax-vbString '(0 . 0)) ) (vlax-for layout (vla-get-Layouts curdwg) (if (/= (vla-get-Name layout) "Model") (setq layout-list (cons (list (vla-get-TabOrder layout) (vla-get-Name layout)) layout-list ) ) ) ) (cond ((= ORDER "Numeric") (setq layout-list (str_num_sort layout-list)) ) ((= ORDER "Tab") (setq layout-list (tab_sort layout-list)) ) ) (if (not REV) ; Layout list to be reversed? (setq layout-list (reverse layout-list)) ) (foreach layout layout-list (prompt (strcat "\nPlotting layout " (itoa (car layout)) ", \"" (cadr layout) "\"...\n" ) ) (setq layout-array (vlax-safearray-fill layout-array (cdr layout)) plot (vla-get-Plot curdwg) ) (vla-SetLayoutsToPlot plot layout-array) (vla-put-NumberOfCopies plot QTY) (setq errmsg (vl-catch-all-apply 'vla-PlotToDevice (list plot DEVICE))) (if (vl-catch-all-error-p errmsg) (prompt (strcat "\nERROR: Plot failed due to following condition:\n " (vl-catch-all-error-message errmsg) "\n" ) ) ) ) (princ) ) ; End plotall_layouts (princ) ;;; ========================================================================== ;;; End PLOTALL.LSP ;;; ========================================================================== //// ------------------------------------------------------------------------- //// File : PlotAll.dcl //// Author : Steve Johnson //// Purpose : Dialogue box definition for PLOTALL command. //// ------------------------------------------------------------------------- /// -------------------------------------------------------------------------- /// Turn off error checking /// -------------------------------------------------------------------------- dcl_settings : default_dcl_settings { audit_level = 0; } /// -------------------------------------------------------------------------- /// Widget: plotall_main /// This is the main PLOTALL dialogue box. /// -------------------------------------------------------------------------- plotall_main : dialog { label = "PlotAll.lsp - Imprime tous les onglets (espace papier) du dessin courant"; : popup_list { key = "device_list"; label = "Imprimante-Traceur "; } spacer; : row { : popup_list { key = "order_list"; label = "Ordre "; } : toggle { key = "reverse"; label = "Ordre Inverse"; } } spacer; : edit_box { key = "quantity"; label = "Quantité"; } spacer; ok_cancel; errtile; } /// -------------------------------------------------------------------------- /// End PlotAll.dcl /// -------------------------------------------------------------------------- :)

Salut J'ai trouvé ce script sur le site suivant http://www.cadchat.com/forums/index.php?s=fbc68490d3c7cecca1364996c06d39eb&showtopic=2871 Si cela peut aider *********************************************************************** ;SCRPLT - SCRIPT PLOTTING ; ;SCRPLT.LSP MAINTAINED BY RUSSEL STEFFY ; FILES REQUIRED WITH PROGRAM : SCRPLT.DCL ; Rev. 1.00 INITIAL VERIFICATION 01MAR00 ; Rev. 1.01 REVISED SIZE FFEMA 20MAR00 ; Rev. 1.02 REVISED write-line routine 05JUL00 ; Rev. 1.03 REVISED TO RETURN LONG FILE NAMES 22AUG00 ; Rev. 1.04 ADDED MULTIPLE PLOT CAPABILITY 07AUG01 ; Rev. 1.05 ADDED SPACE IN FOLDER NAME AND SPACE IN FILE NAME SUPPORT 12MAR02 ; Rev. 1.06 ADDED MULTIPLE FOLDER SUPPORT 12MAR02 ; Rev. 1.07 ADDED AUTOCAD 2004 SUPPORT 25SEP2003 ; Rev. 1.08 ADDED MORE PLOT SIZES (LIST) 18DEC2003 ;***ERROR HANDLING*** (defun scrplterr (s) (if (/= s "Function cancelled") ; If an error (such as CTRL-C) occurs (princ) (princ (strcat "\nError: " s)) ; while this command is active... );if (princ "\n!!!File plot error!!!") (setq *error* olderr) ;Restore old *error* handler (princ) );end scrplterr ;***ERROR HANDLING*** ;***DEFINE C:SCRPLT AND LOCAL VARIABLES*** (defun C:SCRPLT (/ olderr plotdcl DIRLST dcl_id PNAME PLTLST DIRN DIRN1 DIRNAMES end_code OUT_UNIT PLTVW READLIST COUNT ITEM SCRLST SCRLEN LSTPOS DWGNAM OPENDWG NOPL SOURCE WINPATH CNT 2CNT SRC SING_CHAR DOSPATH IN_UNIT INLINE pick_no ) ;***DEFINE C:SCRPLT AND LOCAL VARIABLES*** ;***SAVE OLD VARIABLES AND SET NEW VALUES*** (setq olderr *error* ;Save old *error* handler *error* scrplterr) ;Set new *error* handler (setq plotdcl "SCRPLT.DCL") (setq NOPL 1) (setq PLTLST (list "FFEM A0" "FFEM A1" "FFEM A2" "FFEM A3" "FFEM A4" "FFEM E (34.00 x 44.00 Inches)" "FFEM D (34.00 x 22.00 Inches)" "FFEM C (22.00 x 17.00 Inches)" "FFEM B (11.00 x 17.00 Inches)" "FFEM A (11.00 x 8.50 Inches)" "ISO expand B4 (250.00 x 353.00 MM)" "ISO expand B4 (353.00 x 250.00 MM)" "ISO expand B3 (353.00 x 500.00 MM)" "ISO expand B3 (500.00 x 353.00 MM)" "ISO expand B2 (500.00 x 707.00 MM)" "ISO expand B2 (707.00 x 500.00 MM)" "ISO expand B1 (706.00 x 1000.00 MM)" "ISO expand B1 (1000.00 x 706.00 MM)" "ISO B4 (250.00 x 353.00 MM)" "ISO B4 (353.00 x 250.00 MM)" "ISO B3 (353.00 x 500.00 MM)" "ISO B3 (500.00 x 353.00 MM)" "ISO B2 (500.00 x 707.00 MM)" "ISO B2 (707.00 x 500.00 MM)" "ISO B1 (706.00 x 1000.00 MM)" "ISO B1 (1000.00 x 706.00 MM)" "ISO expand A4 (210.00 x 297.00 MM)" "ISO expand A4 (297.00 x 210.00 MM)" "ISO expand A3 (297.00 x 420.00 MM)" "ISO expand A3 (420.00 x 297.00 MM)" "ISO expand A2 (420.00 x 594.00 MM)" "ISO expand A2 (594.00 x 420.00 MM)" "ISO expand A1 (594.00 x 841.00 MM)" "ISO expand A1 (841.00 x 594.00 MM)" "ISO expand A0 (841.00 x 1189.00 MM)" "ISO expand A0 (1189.00 x 841.00 MM)" "ISO A4 (210.00 x 297.00 MM)" "ISO A4 (297.00 x 210.00 MM)" "ISO A3 (297.00 x 420.00 MM)" "ISO A3 (420.00 x 297.00 MM)" "ISO A2 (420.00 x 594.00 MM)" "ISO A2 (594.00 x 420.00 MM)" "ISO A1 (594.00 x 841.00 MM)" "ISO A1 (841.00 x 594.00 MM)" "ISO A0 (841.00 x 1189.00 MM)" "ISO A0 (1189.00 x 841.00 MM)" "ARCH expand E1 (30.00 x 42.00 Inches)" "ARCH expand E1 (42.00 x 30.00 Inches)" "ARCH expand E (36.00 x 48.00 Inches)" "ARCH expand E (48.00 x 36.00 Inches)" "ARCH expand D (24.00 x 36.00 Inches)" "ARCH expand D (36.00 x 24.00 Inches)" "ARCH expand C (18.00 x 24.00 Inches)" "ARCH expand C (24.00 x 18.00 Inches)" "ARCH expand B (12.00 x 18.00 Inches)" "ARCH expand B (18.00 x 12.00 Inches)" "ARCH expand A (9.00 x 12.00 Inches)" "ARCH expand A (12.00 x 9.00 Inches)" "ARCH E1 (30.00 x 42.00 Inches)" "ARCH E1 (42.00 x 30.00 Inches)" "ARCH E (36.00 x 48.00 Inches)" "ARCH E (48.00 x 36.00 Inches)" "ARCH D (24.00 x 36.00 Inches)" "ARCH D (36.00 x 24.00 Inches)" "ARCH C (18.00 x 24.00 Inches)" "ARCH C (24.00 x 18.00 Inches)" "ARCH B (12.00 x 18.00 Inches)" "ARCH B (18.00 x 12.00 Inches)" "ARCH A (9.00 x 12.00 Inches)" "ARCH A (12.00 x 9.00 Inches)" "ANSI expand E (44.00 x 34.00 Inches)" "ANSI expand E (34.00 x 44.00 Inches)" "ANSI expand D (22.00 x 34.00 Inches)" "ANSI expand D (34.00 x 22.00 Inches)" "ANSI expand C (17.00 x 22.00 Inches)" "ANSI expand C (22.00 x 17.00 Inches)" "ANSI expand B (11.00 x 17.00 Inches)" "ANSI expand B (17.00 x 11.00 Inches)" "ANSI expand A (8.50 x 11.00 Inches)" "ANSI expand A (11.00 x 8.50 Inches)" "ANSI E (44.00 x 34.00 Inches)" "ANSI E (34.00 x 44.00 Inches)" "ANSI D (22.00 x 34.00 Inches)" "ANSI D (34.00 x 22.00 Inches)" "ANSI C (17.00 x 22.00 Inches)" "ANSI C (22.00 x 17.00 Inches)" "ANSI B (11.00 x 17.00 Inches)" "ANSI B (17.00 x 11.00 Inches)" "ANSI A (8.50 x 11.00 Inches)" "ANSI A (11.00 x 8.50 Inches)" )) (reverse PLTLST) (progn (setq SOURCE (getfiled "PICK FILE TO GET PATH" (getvar "DWGPREFIX") "DWG" 16))(princ) (setq WINPATH SOURCE DOSPATH SOURCE) ;***STRIP FILENAME FROM END OF STRING*** (while (/= "\\" (substr WINPATH (strlen WINPATH ) 1)) (setq WINPATH (substr WINPATH 1 (- (strlen WINPATH ) 1))) );while NOT \ ;***STRIP FILENAME FROM END OF STRING*** ; PUT DOUBLE QUOTES AROUND FOLDER NAMES AND FILE NAME (setq CNT 1 SRC (strlen DOSPATH) 2CNT 0) (while (< CNT SRC ) (setq SING_CHAR (substr DOSPATH CNT 1)) (if (= SING_CHAR "\\") (progn (if (>= 2CNT 1) (progn (setq DOSPATH (strcat (substr DOSPATH 1 (- CNT 1)) "\"\\\"" (substr DOSPATH (+ CNT 1)(- SRC CNT)) );strcat );setq (setq CNT (+ CNT 1) 2CNT (+ 2CNT 1)) );progn (progn (setq DOSPATH (strcat (substr DOSPATH 1 CNT) "\"" (substr DOSPATH (+ CNT 1)(- SRC CNT)) );strcat );setq (setq CNT (+ CNT 1) 2CNT (+ 2CNT 1)) );progn );if );progn );if (setq SRC (strlen DOSPATH)) (setq CNT (+ CNT 1)) );while (setq DOSPATH (strcat DOSPATH "\"")) ; PUT DOUBLE QUOTES AROUND FOLDER NAMES AND FILE NAME ;***STRIP FILENAME FROM END OF STRING*** (while (/= "\\" (substr DOSPATH (strlen DOSPATH ) 1)) (setq DOSPATH (substr DOSPATH 1 (- (strlen DOSPATH ) 1))) );while NOT \ ;***STRIP FILENAME FROM END OF STRING*** (setq DIRNAMES (strcat DOSPATH"*.DWG")) (prompt "\nCreating directory list file, please wait ... ") (command "SHELL" (strcat "DIR " DIRNAMES "/B/A:-d/O:-n>" DOSPATH"DIR.LST")) ;make dir.lst file (setq IN_UNIT (open (strcat WINPATH"DIR.LST") "r"));open DIR.lst file (setq COUNT 0) (while (setq INLINE (read-line IN_UNIT)) ;read line (progn ;from (setq DIRN (substr INLINE 1 (- (strlen INLINE) 4)));dir.lst (setq COUNT (1+ COUNT)) ;file (if (= COUNT 1) ;construct (progn (setq DIRN1 DIRN) ;DIRLST (setq DIRLST (list DIRN1)) );progn );if ;list (if (= COUNT 2) ;line (setq DIRLST (list DIRN DIRN1)) ;by );if ;line (if (>= COUNT 3) ;from (setq DIRLST (cons DIRN DIRLST)) ;dir.lst );if ;file );progn );while (close IN_UNIT) ;close dir.lst file );progn ;***SAVE OLD VARIABLES AND SET NEW VALUES*** ;***DIALOG BOX TO PICK LISP PROGRAM*** (setq dcl_id (load_dialog plotdcl)) (if (not (new_dialog "scr_plt" dcl_id)) (exit) );if (start_list "SIZELIST") (mapcar 'add_list PLTLST) (end_list) (start_list "PLOTLIST") (mapcar 'add_list DIRLST) (end_list) (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (action_tile "NOPL" "(setq NOPL (atoi $value))") (action_tile "SIZELIST" "(setq pick_no $value)") (action_tile "PLOTLIST" "(setq READLIST $value)") (setq end_code (start_dialog)) (unload_dialog dcl_id) (if (= end_code 0) (exit) );if (if pick_no (setq PNAME (nth (atoi pick_no) PLTLST))) (setq PLTVW "E") (setq COUNT 1) (while (setq ITEM (read READLIST)) (setq SCRLST (cons (nth ITEM DIRLST) SCRLST)) (while (and (/= " " (substr READLIST COUNT 1)) (/= "" (substr READLIST COUNT 1)) );and (setq COUNT (1+ COUNT)) );while (setq READLIST (substr READLIST COUNT )) );while (if (= PNAME nil)(setq PNAME "FFEM A3")) (setq SCRLEN (length SCRLST)) (setq LSTPOS 0) (setq OUT_UNIT (open (strcat WINPATH"PLT.SCR") "w")) (repeat SCRLEN ;********START REPEAT******** (setq DWGNAM (nth LSTPOS SCRLST)) (setq OPENDWG (strcat "OPEN ""\""WINPATH DWGNAM"\"")) (write-line "QSAVE" OUT_UNIT) ;write cmd.scr file (write-line "CLOSE" OUT_UNIT) (write-line OPENDWG OUT_UNIT) (write-line "ZOOM" OUT_UNIT) (write-line "EXTENTS" OUT_UNIT) (write-line "QSAVE" OUT_UNIT) (repeat NOPL (write-line "(if (= (getvar \"CTAB\") \"Model\")(setq test \"A\")(setq test \"N\"))(princ)" OUT_UNIT) (write-line "PLOT" OUT_UNIT) (write-line "Y" OUT_UNIT) (write-line "(getvar \"CTAB\")" OUT_UNIT) (write-line "\\\\Ffecad\\Acad2004\\Plotters\\XES 8830 HDI.pc3" OUT_UNIT) (write-line PNAME OUT_UNIT) (write-line "I" OUT_UNIT) (write-line "L" OUT_UNIT) (write-line "N" OUT_UNIT) (write-line PLTVW OUT_UNIT) (write-line "F" OUT_UNIT) (write-line "0.00,0.00" OUT_UNIT) (write-line "Y" OUT_UNIT) (write-line "." OUT_UNIT) (write-line "Y" OUT_UNIT) (write-line "(princ test)" OUT_UNIT) (write-line "N" OUT_UNIT) (write-line "N" OUT_UNIT) (write-line "(if (= (getvar \"CTAB\") \"Model\")(princ)(setq test \"N\"))" OUT_UNIT) (write-line "(if (= (getvar \"CTAB\") \"Model\")(princ)(setq test \"N\"))" OUT_UNIT) (write-line "Y" OUT_UNIT) );repeat (setq LSTPOS (+ LSTPOS 1)) );repeat *********END REPEAT*********** (write-line "QSAVE" OUT_UNIT) ;write cmd.scr file (close OUT_UNIT) ;close cmd.scr file (setq *error* olderr) ;Restore old *error* handler (command ".SCRIPT"(strcat WINPATH"PLT")) ;plot drawing (princ) );scrplt.lsp *********************************************************************** Scrplt.dcl scr_plt : dialog { label = "SCRPLT.LSP Rev. 1.08"; : text { label ="Maintained by russ.steffy@ffeminerals.com"; } :row{ : text { label ="With no selection default size = FFEM A3 "; } : edit_box { label = "Number of plots per drawing selected: "; value = "1"; key = "NOPL"; edit_width = 4; } } :row{ : list_box { allow_accept = true; key = "SIZELIST"; height = 12; width = 40; } : list_box { multiple_select = true; key = "PLOTLIST"; height = 12; width = 40; } } ok_cancel; } :)

Sur ce site http://www.jefferypsanders.com/ tu trouveras le programme XL. salut, X13

Voiçi deux programme qui peuvent servir de base pour créer celui qui répondra à tes besoins. Le premier que tu retrouveras sur WWW.afralisp.com ;;;*THIS PARAMETRIC ROUTINE DRAWS MECHANICAL BOLTS (GR. 4.6) ;;;*ELEVATION ;;;*Written by K. Ramage October 1994. ;;;*-------------------------------------------------------- (defun C:BOLT (/ siz size file fp item data maxs count chrct numb dlist N S W E P1 P2 P3 P4 P5 P6 P7 P8 P9 P10 P11 P12 P13 P14 ANG IP P15 P16 P17 P18 P19 P20 P21 P22 P23 P24 P25 NAMES ) ;;;*--------------------------------------------------------- ;;;*CONVERT TO RADIANS (setq N (* pi (/ 90.0 180.0)) S (* pi (/ 270.0 180.0)) W pi E 0 ANG (* pi (/ 30.0 180.0)) ) ;setq ;;;*---------------------------------------------------------- ;;;*INITIALISE (initerr) (setvar "CMDECHO" 0) (setvar "BLIPMODE" 0) (setq NAMES '("M6" "M8" "M10" "M12" "M16" "M20" "M24" "M30" "M36")) (setq dcl_id (load_dialog "BOLT.dcl")) (if (not (new_dialog "BOLT" dcl_id)) (setq userclick nil) ) (start_list "selections") (mapcar 'add_list NAMES) (end_list) (action_tile "cancel" "(done_dialog) (setq userclick nil)" ) (action_tile "accept" (strcat "(progn (setq SIZ (atof (get_tile \"selections\")))" " (done_dialog)(setq userclick T))" ) ) (start_dialog) (unload_dialog dcl_id) (if userclick (progn (setq SIZ (fix SIZ)) (setq SIZ (nth SIZ NAMES)) ;;;*---------------------------------------------------------- ;;;*FILE & INFORMATION RETRIEVAL ROUTINE. (setq dlist nil size (strcat "*" siz) file (findfile "BOLT.DAT") fp (open file "r") item (read-line fp) );setq (while item (if (= item size) (setq data (read-line fp) item nil );setq (setq item (read-line fp)) );if );while (if data (progn (setq maxs (strlen data) count 1 chrct 1 );setq (while (< count maxs) (if (/= "," (substr data count 1)) (setq chrct (1+ chrct)) (setq numb (atof (substr data (1+ (- count chrct)) chrct)) dlist (append dlist (list numb)) chrct 1 );setq );if (setq count (1+ count)) );while (setq numb (atof (substr data (1+ (- count chrct)))) dlist (append dlist (list numb)) );setq );progn );if data (close fp) ;;;*----------------------------------------------------------- ;;;*----------------------------------------------------------- ;;;*THIS ROUTINE DRAWS A MECHANICAL BOLT. ;;;* (mapcar 'set '(B A C) dlist) (initget 1) (setq IP (getpoint "\nInsertion Point: ")) (setvar "OSMODE" 0) (setq B1 (* (sin ANG) (/ A 2)) B2 (* B1 2) R (/ B2 (sin ANG)) R1 (sqrt (- (* R R) (* B1 B1))) TH (- R R1) P1 (polar IP W B1) P2 (polar P1 W (/ B1 2)) P3 (polar P1 W (- B1 TH)) P4 (polar P3 W TH) P5 (polar P4 N TH) P6 (polar P5 N (- C TH TH)) P7 (polar P6 N TH) P8 (polar P7 E TH) P9 (polar P8 E (- (/ B1 2) TH)) P10 (polar P9 E (/ B1 2)) P11 (polar P10 E B1) P12 (polar P11 E B1) P13 (polar P12 E (/ B1 2)) P14 (polar P12 E (- B1 TH)) P15 (polar P14 E TH) P16 (polar P15 S TH) P17 (polar P16 S (- C TH TH)) P18 (polar P17 S TH) P19 (polar P18 W TH) P20 (polar P19 W (- (/ B1 2) TH)) P21 (polar P20 W (/ B1 2)) P22 (polar P1 N TH) P23 (polar P10 S TH) P24 (polar P12 S TH) P25 (polar P21 N TH) ) ;setq (mark) (command "PLINE" IP "W" "0.0" "" P4 P6 P8 P14 P16 P18 IP "" "PLINE" P1 P23 "" "PLINE" P21 P24 "" "PLINE" P6 "ARC" "S" P9 P23 "" "PLINE" P23 "ARC" "S" P11 P24 "" "PLINE" P24 "ARC" "S" P13 P16 "" ) ;command (prompt "\nRotation Angle: ") (command "ROTATE" (catch) "" IP pause ) ;command );progn );if (reset) (princ) ) ;defun C:BOLT ;;*---------------------------------------------------------------------- (defun MARK ( / val) (setq val (getvar "cmdecho")) (setvar "cmdecho" 0) (if (setq #mark (entlast)) nil (progn (entmake '( (0 . "POINT") (10 0.0 0.0 0.0))) (setq #mark (entlast)) (entdel #mark) ) ) (setvar "cmdecho" val) (princ) ) ;* ;;;*------------------------------------------------------------------- ;* CATCH starts at MARK and retrieves to the end of the database. (defun CATCH ( / ss) (if #mark (progn (setq ss (ssadd)) (while (setq #mark (entnext #mark)) (ssadd #mark ss) );while ss );progn then (prompt "\n#MARK not set. Run MARK before CATCH.\n") ;else );if );defun (princ) ;* end of CATCH.LSP ;;;*--------------------------------------------------------- (defun initerr () (setq oldlayer (getvar "clayer")) (setq oldsnap (getvar "osmode")) (setq oldpick (getvar "pickbox")) (setq temperr *error*) (setq *error* trap) ; (mark) (princ) ) ;defun ;;;*=========================================================== (defun trap (errmsg) (command nil nil nil) (if (not (member errmsg '("console break" "Function Cancelled")) ) (princ (strcat "\nError: " errmsg)) ) ; ; (command "erase" (catch) "") (setvar "clayer" oldlayer) (setvar "blipmode" 1) (setvar "menuecho" 0) (setvar "highlight" 1) (setvar "blipmode" 1) (setvar "osmode" oldsnap) (setvar "pickbox" oldpick) (princ "\nError Resetting Enviroment ") (terpri) (setq *error* temperr) (princ) ) ;defun ;;;*=========================================================== (defun reset () (princ "\nRestoring Settings") (setq *error* temperr) (setvar "clayer" oldlayer) (setvar "blipmode" 1) (setvar "menuecho" 0) (setvar "highlight" 1) (setvar "blipmode" 1) (setvar "osmode" oldsnap) (setvar "pickbox" oldpick) (princ) ) ;defun (princ) Et le fichier DCL de la boîte de dialogue: dcl_settings : default_dcl_settings { audit_level = 3; } BOLT : dialog { label = "Boulons - Elevation"; : list_box { label = "Dimension :"; key = "selections"; height = 12; } :row { : button { label = "OK"; key = "accept"; width = 8; fixed_width = true; } : button { label = "Cancel"; is_cancel = true; key = "cancel"; width = 8; fixed_width = true; } } :text_part { label = "Conçu et créé"; } :text_part { label = "par Kenny Ramage"; } } Le fichier .dat ;;;*BOLT ELEVATION DATA *M6 10.0,11.5,4.38 *M8 13.0,15.0,5.88 *M10 17.0,19.9,7.45 *M12 19.0,21.9,8.45 *M16 24.0,27.7,10.45 *M20 30.0,34.6,13.9 *M24 36.0,41.6,15.9 *M30 46.0,53.1,20.05 *M36 55.0,63.5,24.05 ;;;*------------------- ; Le deuxième: ;Tip1638: BOLT.LSP Hex Bolts ©2000, Vito Messina (defun C:BOLTS () (setq XOSMODE (getvar "osmode")) (setvar "OSMODE" 0) (setq DEFBS BS) (setq DEFLG LG) (setq DEFT TT) (setq DEFWT WT) (setq DEFANG ANG) (setq DEFHEADOP HEADOP) (princ "\nEntrer diametre du boulon <") (princ DEFBS) (setq BS (getreal " in >:")) (if (= BS NIL) (setq BS DEFBS) ) ;_ end of if (princ "Dessine tête de boulon(D) seulement ou (E)boulon en entier <") (princ DEFHEADOP) (setq HEADOP (getstring ">:")) (if (= HEADOP "") (setq HEADOP DEFHEADOP) ) ;_ end of if (setq HEADOP (strcase HEADOP)) (if (= HEADOP "E") (progn (princ "Entrer longueur de l'étreinte (gap) <") (princ DEFLG) (setq LG (getreal " in >:")) (if (= LG NIL) (setq LG DEFLG) ) ;_ end of if (princ "Montrer corps du boulon comme(S)olid/(H)idden-caché/(N)one-aucun <") (princ DEFT) (setq TT (getstring ">:")) (if (= TT "") (setq TT DEFT) ) ;_ end of if (setq TT (strcase TT)) ) ;_ end of progn ) ;_ end of if (if (= HEADOP "D") (setq LG 0.0) ) ;_ end of if (princ "Entrer épaisseur de la rondelle <") (princ DEFWT) (setq WT (getreal " in>:")) (if (= WT NIL) (setq WT DEFWT) ) ;_ end of if (princ "\nEntrer orientation angle <") (princ DEFANG) (setq ANG (getreal " Degeers >:")) (if (= ANG NIL) (setq ANG DEFANG) ) ;_ end of if (setq ANG (+ ANG 90.0)) (command "ucs" "z" ANG "") (princ) (setq P0 (getpoint "\n Sélectionné point d'insertion: ")) ;(setq p0 (list (- (car p0) wt) (cadr p0))) (setq HEADOP (strcase HEADOP)) (setq B (/ 1.0 2.0)) ;bolt rad (setq C1 (/ 15.0 16.0)) ;width across corners (setq C2 (/ 7.0 16.0)) (setq CH (/ 11.0 16.0)) ;head height (setq C3 (/ 21.0 32.0)) (setq C4 (/ 7.0 16.0)) (setq C5 (/ 1.5 1.0)) (setq C6 (/ 1.0 8.0)) ;champher (setq C7 (/ 1.0 4.0)) (setq C8 (/ 3.0 8.0)) ;3 threads (setq WD (* 1.125 BS)) ;washer dia (setq BD (* BS B)) ;bolt dia (setq LH (* CH BS)) ;head height (setq LT (* C8 BS)) (setq LB (+ LH LG)) (setq L1 (* C1 BS)) (setq L2 (* C2 BS)) (setq L3 (* C3 BS)) (setq L4 (* C4 BS)) (setq L5 (* C5 BS)) (setq L6 (* C6 BS)) (setq LB1 (- LB L6)) (setq CL1 (+ LB L1 C7 C7 LT)) ;length of cl (setq CL (+ L1 C7)) (setq BD1 (- BD L6)) (setq THL (+ BS BS C7)) ;head washer (setq W1 (list (car P0) (+ (cadr P0) WT))) (setq W2 (list (+ (car W1) WD) (cadr W1))) (setq W3 (list (car W2) (- (cadr W2) WT))) (setq W4 (list (- (car W3) L1 WD) (cadr W3))) (setq W5 (list (+ (car P0) L4) (cadr P0))) ;Bolt Head (setq P1 (list (+ (car P0) L1) (+ (cadr P0) WT))) (setq P2 (list (car P1) (+ (cadr P1) L2))) (setq P3 (list (car P0) (+ (cadr P1) LH))) (setq P4 (list (+ (car P3) L3) (cadr P3))) (setq P5 (list (+ (car P0) L4) (+ (cadr P0) WT))) (setq P6 (list (car P5) (+ (cadr P5) L2))) (setq P7 (list (- (car P0) L4) (+ (cadr P0) WT))) (setq P8 (list (car P7) (+ (cadr P7) L2))) ;center line (setq P9 (list (car P0) (+ (cadr P0) CL))) (setq P10 (list (car P9) (- (cadr P9) CL1 WT WT))) ;Bolt Shank (setq P11 (list (+ (car P0) BD) (- (cadr P0) LB WT))) (setq P12 (list (car P11) (- (cadr P11) LT))) (setq P13 (list (- (car P0) BD) (- (cadr P0) LB WT))) (setq P14 (list (car P13) (- (cadr P13) LT))) (setq P15 (list (car P0) (- (cadr P0) LB LT L6 WT))) (setq P16 (list (+ (car P15) BD1) (cadr P15))) (setq PS1 (list (+ (car P0) BD) (cadr P0))) (setq PS2 (list (car PS1) (- (cadr PS1) LG))) ;thread (setq P17 (list (- (car P12) L6) (+ (cadr P15) WT))) (setq P18 (list (car P17) (+ (cadr P17) LT))) ;draw center line (command "line" P9 P10 "") (command "chprop" "l" "" "LType" "center" "") ;draw bolt head (command "line" P1 P2 "") (command "mirror" "l" "" P9 P10 "") (command "line" P3 P4 "") (command "mirror" "l" "" P9 P10 "") (command "line" P7 P8 "") (command "mirror" "l" "" P9 P10 "") (command "arc" P6 P4 P2 "") (command "mirror" "l" "" P9 P10 "") (command "arc" P6 P3 P8 "") (command "mirror" "l" "" P9 P10 "") ;draw head washer (command "line" W1 W2 "") (command "mirror" "l" "" P9 P10 "") (command "line" W2 W3 "") (command "mirror" "l" "" P9 P10 "") (command "line" W3 W4 "") (command "mirror" "l" "" P9 P10 "") (if (= HEADOP "E") (progn ;draw bolt shank (command "line" P11 P12 "") (command "mirror" "l" "" P9 P10 "") (command "line" P13 P14 "") (command "mirror" "l" "" P9 P10 "") (command "line" P12 P14 "") (command "mirror" "l" "" P9 P10 "") (command "line" P15 P16 "") (command "mirror" "l" "" P9 P10 "") (command "line" P16 P12 "") (command "mirror" "l" "" P9 P10 "") (if (= TT "N") (setq PS1 PS2) ) ;_ end of if (if (= TT "H") (command "line" PS1 PS2 "") ) ;_ end of if (command "chprop" "l" "" "LType" "hidden" "") (command "mirror" "l" "" P9 P10 "") (if (= TT "S") (command "line" PS1 PS2 "") ) ;_ end of if (command "mirror" "l" "" P9 P10 "") ;draw thread (command "line" P17 P18 "") (command "chprop" "l" "" "LType" "hidden" "") (command "mirror" "l" "" P9 P10 "") ;nut (setq P0 (list (car P0) (- (cadr P0) LG))) (setq P1 (list (+ (car P0) L1) (- (cadr P0) WT))) (setq P2 (list (car P1) (- (cadr P1) L2))) (setq P3 (list (car P0) (- (cadr P1) LH))) (setq P4 (list (+ (car P3) L3) (cadr P3))) (setq P5 (list (+ (car P0) L4) (- (cadr P0) WT))) (setq P6 (list (car P5) (- (cadr P5) L2))) (setq P7 (list (- (car P0) L4) (- (cadr P0) WT))) (setq P8 (list (car P7) (- (cadr P7) L2))) ;nut washer (setq W11 (list (car P0) (- (cadr P0) WT))) (setq W21 (list (+ (car W11) WD) (cadr W11))) (setq W31 (list (car W21) (+ (cadr W21) WT))) (setq W41 (list (- (car W31) L1 WD) (cadr W31))) ;DRAW NUT (command "line" P0 P1 "") (command "mirror" "l" "" P9 P10 "") (command "line" P1 P2 "") (command "mirror" "l" "" P9 P10 "") (command "line" P3 P4 "") (command "mirror" "l" "" P9 P10 "") (command "line" P5 P6 "") (command "mirror" "l" "" P9 P10 "") (command "line" P7 P8 "") (command "arc" P6 P4 P2 "") (command "mirror" "l" "" P9 P10 "") (command "arc" P6 P3 P8 "") ;draw nut washer (command "line" W11 W21 "") (command "mirror" "l" "" P9 P10 "") (command "line" W21 W31 "") (command "mirror" "l" "" P9 P10 "") (command "line" W31 W41 "") (command "mirror" "l" "" P9 P10 "") ) ;_ end of progn ) ;_ end of if (command "ucs" "w" "") (setq ANG (- ANG 90.0)) (redraw) (setvar "OSMODE" XOSMODE) (princ) ) ;_ end of defun Salut, François

Voiçi celui que j'utilise; ;Tip1565a: PROFILE.LSP Switch Profiles ©1999, Amy Ang ;R2000 only (defun c:profile (/ app disp NoScreen pName pref prof dat activep n m index var) (vl-load-com) (setq app (vlax-get-acad-object)) (setq pref (vla-get-preferences app)) (setq prof (vla-get-profiles pref)) (setq disp (vla-get-display pref)) (setq NoScreen (vla-get-DisplayScreenMenu disp)) (setq activeP (vla-get-ActiveProfile prof)) (vla-GetAllProfileNames prof 'var) (setq pName (vlax-safearray->list var)) (if pName (setq pName (acad_strlsort pName)) ) ;_ end of if (setq n (length pName)) (if (> (setq m (length (member activeP pName))) 0) (setq index (- n m)) nil ) ;_ end of if (setq dat (load_dialog "profile.dcl")) (if (not (new_dialog "profile" dat)) (exit) ) ;_ end of if (if (= NoScreen :vlax-true) (set_tile "smenu" "1") (set_tile "smenu" "0") ) ;_ end of if (set_tile "active" ActiveP) (start_list "seting") (mapcar 'add_list pName) (end_list) (mode_tile "seting" 2) (set_tile "seting" (itoa index)) (action_tile "smenu" "(SMenu_on/off)") (action_tile "seting" "(Sprofile $value)") (action_tile "cancel" "(done_dialog)(exit)") (start_dialog) (unload_dialog dat) (princ) ) ;_ end of defun (defun SMenu_on/off () (if (= (get_tile "smenu") "1") (vla-put-DisplayScreenMenu disp :vlax-true) ) ;_ end of if (if (= (get_tile "smenu") "0") (vla-put-DisplayScreenMenu disp :vlax-false) ) ;_ end of if (princ) ) ;_ end of defun (defun SProfile (val) (set_tile "active" (nth (atoi val) pName)) (vla-put-ActiveProfile prof (nth (atoi val) pName)) (setq NoScreen (vla-get-DisplayScreenMenu disp)) (if (= NoScreen :vlax-true) (set_tile "smenu" "1") (set_tile "smenu" "0") ) ;_ end of if (princ) ) ;_ end of defun //Tip1565b: PROFILE.DCL Switch Profiles ©1999, Amy Ang profile : dialog { key="active"; initial_focus=cancel; : list_box { key = "seting"; label = "&Profils utilisateurs disponibles"; width = 40; } : toggle { key = "smenu"; label = "&Menu écran"; } cancel_button; } Pour le bouton Changeprofiles.bmp, ^C^C(if(not C:profile)(load"profile"));profile comme le transfert est impossible donc voir Cadalyst.com, Get the code August 2002. Salut, François

Un exemple de lisp utilisant Excel dans Autocad, voir XL sur ce site www.jefferypsanders.com/ Salut, François

Voiçi un site pour référence http://www.kncrowder.com/slidingdoor/index.html Si cela peut aider. Salutations. François

Tu peux utilisé du RTEXT tel que l'exemple ci-joint. Dessin fichier: $(getvar, "dwgprefix")$(getvar, "dwgname") Imprimer par: $(getvar, "loginname")--> Date d'impression:$(edtime, 0, MON DD"," YYYY - H:MMam/pm) Si tu me fourni ton adresse de courriel, je peux t'envoyer deux blocs contenant des RTEXT. Salut, x13

Jette un coup d'oeil sur le programme library sur ce site http://www.jefferypsanders.com/ Salut,

Tutoriels en anglais: http://www.jefferypsanders.com/ http://www.afralisp.com/ http://www.gregmacg.com/ Tutoriels en esopagnol: http://www.gr-acad.arq.br/paginas/efer100.htm Bon apprentissage.

Jette un coup d'oeil sur ce site http://www.collegeahuntsic.qc.ca/pagesdept/g_civil_geod/geniecivil/PagesProf/Luc/DAO.html Salut. [Edité le 29/9/2004 par x13]

J'a un petit programme d'aide qui pourra répondre sûrement à tes besoins. Donne-moi ton courriel en message privé et je t'envoie les fichiers. Salutations.

Il y a également XL sur ce site http://www.jefferypsanders.com/autolisp_XL.html Salut,

1) Calques ou couches ->français, Layers ->anglais 2)Voir les tutoriels sur Cadx ou sur http://antoineprieurdrevon.free.fr/ 3)Voir envoi précédent.

Tu trouveras des bibliothèques sur ces adresses http://www.ac-nice.fr/etabs/geniecivil/outils/autocad.htm http://www.newz.net/acadplus/ http://members.eunet.at/nigg/index2_e.html http://www.fs.fed.us/database/acad/ http://www.jefferypsanders.com/index.html salutations,

Peut-être que ce petit lisp de Tonton Jules répond à vos besoin. Salutations, X13 ;| MINMAJ.LSP Changer la casse d'un texte, d'un texte multilignes, d'une valeur d'attribut, d'une définition d'attribut. |; (defun c:minmaj (/ selec nomobj lstobj comptlst lglst propobj typobj ancval comptchain ancchain lgchain carac codeasc nouchain nouval) (princ "\nminmaj.lsp - Version 1.0 - Pour AUTOCAD 2002 - Par Tonton Jules - CADAGOGO -") (princ "\nLe 25-11-2002 - DH-HELP - © Copyright 2002") ; (setvar "cmdecho" 0) ; ;===> Choix des objets ; (setq selec (nentsel "\nChoix du texte à modifier:")); ; ;===> Tant que l'on choisit des objets - Création d'une liste contenant tous les textes ; (while (/= selec nil) (setq nomobj (car selec) lstobj (cons nomobj lstobj) selec (nentsel "\nChoix du texte à modifier:") );===> Fin setq );===> Fin while ; ;===> On met la liste à l'endroit - Initialiser le compteur d'objets sélectionnés - Longueur de la liste ; (setq lstobj (reverse lstobj) comptlst 0 lglst (length lstobj) );===> Fin setq ; ;===> Traitement de tout les éléments sélectionnés (Ceux de la liste) ; (while (<= comptlst (- lglst 1)) ; ;===> Récupèrer le 1er objet de la liste et le type d'objet dans sa liste de propriété - Boucler sur tous les objets de la liste ; (setq nomobj (nth comptlst lstobj) propobj (entget nomobj) typobj (cdr (assoc 0 propobj)) );===> Fin setq ; ;===> Si cet objet est un texte, un texte multilignes, un attribut, une définition d'attribut ; (if (or (= typobj "TEXT") (= typobj "MTEXT") (= typobj "ATTDEF") (= typobj "ATTRIB")) (progn;===> C'est un texte ou un texte multiligne ou un attribut ou une définition d'attribut ; ;===> On récupère la liste contenant la chaine de caractère dans la liste des propriétés de l'objet ; (if (= typobj "ATTDEF") (progn;===> L'objet est une définition d'attribut (setq ancval (assoc 2 propobj)) );===> Fin progn L'objet est une définition d'attribut (progn;===> L'objet est un texte, un texte multiligne, un attribut (setq ancval (assoc 1 propobj)) );===> Fin progn L'objet est un texte, un texte multiligne, un attribut )==> Fin if ; ;===> Initialisation du compteur de longueur de chaine de caractère - Récupération de la chaine - Longueur de la chaine ; (setq comptchain 1 ancchain (cdr ancval) lgchain (strlen ancchain) );===> Fin setq ; ;===> Traitement de la chaine tant que le dernier caractère n'a pas été éxaminé ; (while (<= comptchain lgchain) ; ;===> On extrait le premier caractère de la chaine - Récupèrer le code ascii du caractère ; (setq carac (substr ancchain comptchain 1) codeasc (ascii carac) );===> Fin setq ; ;===> On analyse si le caractère est une majuscule ou une minuscule ; (cond ((and (> codeasc 64) (< codeasc 91));===> C'est une majuscule - Transformation en minuscule (setq codeasc (+ codeasc 32) carac (chr codeasc) );===> Fin setq );===> Fin cond C'est une majuscule ((and (> codeasc 96) (< codeasc 123));===> C'est une minuscule - Transformation en Majuscule (setq codeasc (- codeasc 32) carac (chr codeasc) );===> Fin setq );===> Fin cond C'est une minuscule );===> Fin cond de test majuscule/Minuscule ; ;===> Construction de la nouvelle chaine de caractères ; (if (/= nouchain nil) (progn;===> Si ce n'est pas le 1er caractère de la chaine (setq nouchain (strcat nouchain carac)) );===> Fin progn ce n'est pas le 1er caractère de la chaine (progn;===> C'est le 1er caractère de la chaine (setq nouchain carac) );===> Fin progn C'est le 1er caractère de la chaine );===> Fin if construction de la chaine ; ;===> Incrémentation du compteur de position du caractère dans la chaine ; (setq comptchain (+ comptchain 1)) ; ;===> Fin while traitement de la chaine de caractère ; ) ; ;===> Création de la nouvelle liste de l'objet ; (if (= typobj "ATTDEF") (progn;===> C'est une définition d'attribut (setq nouval (cons 2 nouchain)) );===> Fin progn C'est une définition d'attribut (progn;===> C'est un texte, un texte multiligne, un attribut (setq nouval (cons 1 nouchain)) );===> Fin progn C'est un texte, un texte multiligne, un attribut );===> Fin if création de la nouvealle liste de l'objet ; ;===> Substituer la nouvelle liste de l'objet à l'ancienne dans la liste des propriétés de l'objet ; (setq propobj (subst nouval ancval propobj)) ; ;===> Mettre à jour l'objet dans le dessin (Mettre à jour sa liste des propriétés) ; (entmod propobj) ; ;===> Si c'est un attribut (Mettre en plus à jour l'objet) ; (if (= typobj "ATTRIB") (entupd nomobj) );===> Fin if ; ;===> Fin progn C'est un texte ou un texte multiligne ou un attribut ou une définition d'attribut ; ) ; ;===> Fin if Si cet objet est un texte, un texte multilignes, un attribut, une définition d'attribut ; ) ; ;===> Incrémentation du compteur de la liste des objets sélectionnés - Mise à nil de la variable pour la nouvelle chaine de caractères ; (setq comptlst (+ comptlst 1) nouchain nil );===> Fin setq ; ;===> Fin du traitement de tous les objets sélectionnés ; );===> Fin while (setvar "cmdecho" 1) ; ;===> Sortir en beauté ; (prin1) );===> Fin defun (princ "\nPour lancer le programme, taper minmaj")

Merçi pour les informations et conseils relatifs à ce type de fichier. Sur la version 2000, je n'utilise pas ces fichiers, je vais demander à l'expéditeur de me fournir ce qui manque. Salutations.