PHILPHIL

hello Gile dans ton programme INCREMENTE 2.3 en utilisant l'incrémentation "AUTO" des blocs trier par "Y" et "X" certains bloc sont inversés pourtant ils ont la meme altimétrie "Y" ( avec 8 chiffres apres la virgule ) quand on regarde dans la boite des propriétés. dans ton programme quelle est la tolérance pour les coordonnées "Y" "X" ? elle ne serait pas de 10 chiffres ou plus par hazard ? ce qui fausserait le résultat. mais ne serait pas visible dans la boite de propriété merci a+ Phil

bonjour MISE A JOUR : MISE A L ECHELLE DU FICHIER SAUVEGARDE je recois des fois des fichiers avec toutes les présentations dans l'espace objet et a des échelles différentes non égales a l'échelle 1 voici une fonction pour faire des extraits de fichier en dwg etape1 : choisir le repertoire d'extraction sauve_repertoire_bloc etape 2 : choisir un nom d'extraction dwg, choisir objets, choisir point de base fichier_extrait_fichier_repertoire_bloc fichier_extrait_fichier_repertoire_bloc_mise_echelle il faut les express tools je pense ( pour choisir le sous repertoire de sauvegarde ) ps1 : merci a Gile pour ses routines ps2 : on ne peut plus déposer de fichier *.lsp ?? a+ Phil (setcustombykey "REPERTOIRE_BLOC" "...") ;;;------------------------------------------------- ;;;SAUVEGARDER FAIRE DES EXTRAITS DE FICHIERS EN DWG ;;;------------------------------------------------- (defun c:fichier_extrait_fichier_repertoire_bloc () (setvar "cmdecho" 0) ; pour definier les noms longs à changer suivant la version d'autocad et de windows (setq repertoire_bloc (gc:getcustombykey "REPERTOIRE_BLOC")) (prompt (strcat "\nLE REPERTOIRE DES BLOCS DE L'OPERATION EST : " repertoire_bloc)) (setq nomextraitfichier (getcfg "APPDATA/NOMEXTRAITFICHIER")) (setq boite "ENTRER LE NOM DU FICHIER DE SAUVEGARDE DE L'EXTRAIT ") (setq message "NOUVEAU NOM DE L'EXTRAIT") (inputbox2 boite message nomextraitfichier) (if (/= ret "") (setq nomextraitfichier ret) ) (setcfg "APPDATA/NOMEXTRAITFICHIER" nomextraitfichier) (setq poi nil) (while (null poi) (setq poi (getpoint "\nPOINT DE REFERENCE DU FICHIER EXTRAIT"))) (prompt (strcat "\nCLIQUER SUR LES OBJETS A EXTRAIRE DANS UN FICHIER")) (setq obj nil) (while (null obj) (setq obj (ssget))) (command-s "scu" "ez" poi "") (command-s "-WBLOC" (strcat repertoire_bloc "\\" nomextraitfichier ".DWG") "" poi obj "") (command-s "ANNULER" "") (command-s "scu" "p") (princ) ) (defun c:fichier_extrait_fichier_repertoire_bloc_mise_echelle () (setvar "cmdecho" 0) ; pour definier les noms longs à changer suivant la version d'autocad et de windows (setq repertoire_bloc (gc:getcustombykey "REPERTOIRE_BLOC")) (prompt (strcat "\nLE REPERTOIRE DES BLOCS DE L'OPERATION EST : " repertoire_bloc)) (setq nomextraitfichier (getcfg "APPDATA/NOMEXTRAITFICHIER")) (setq boite "ENTRER LE NOM DU FICHIER DE SAUVEGARDE DE L'EXTRAIT ") (setq message "NOUVEAU NOM DE L'EXTRAIT") (inputbox2 boite message nomextraitfichier) (if (/= ret "") (setq nomextraitfichier ret) ) (setcfg "APPDATA/NOMEXTRAITFICHIER" nomextraitfichier) (setq refech2 (atof (getcfg "APPDATA/refech2"))) (initget 4) (setq tmp (getdist (strcat "\nENTRER LA VALEUR DE MISE A L'ECHELLE < " (rtos refech2 2 8) " >: "))) (if tmp (setq refech2 tmp) ) (setcfg "APPDATA/refech2" (rtos refech2 2 8)) (setq poi nil) (while (null poi) (setq poi (getpoint "\nPOINT DE REFERENCE DU FICHIER EXTRAIT"))) (prompt (strcat "\nCLIQUER SUR LES OBJETS A EXTRAIRE DANS UN FICHIER")) (setq obj nil) (while (null obj) (setq obj (ssget))) (command-s "scu" "ez" poi "") (command-s "ECHELLE" obj "" "0,0,0" refech2) (command-s "-WBLOC" (strcat repertoire_bloc "\\" nomextraitfichier ".DWG") "" poi obj "") (command-s "ANNULER" "") (command-s "ANNULER" "") (command-s "scu" "p") (princ) ) ;; InputBox (gile) ;; Ouvre une boite de dialogue pour récupérer une valeur ;; sous forme de chaine de caractère ;; ;; Arguments ;; tous les arguments sont de chaines de caractère (ou "") ;; box : titre de la boite de dialogue ;; msg : message d'invite ;; val : valeur par défaut ;; ;; Retour ;; une chaine ("" si annulation) ;; ;; Modifié par Patrick_35 pour inclure le caractère \n ;; comme retour chariot (defun inputbox2 (box msg val / subr temp file dcl_id ;;ret ) ;; Retour chariot automatique à 50 caractères (defun subr (str / pos) (cond ((setq pos (vl-string-search "\n" str)) (strcat ":text_part{label=\"" (substr str 1 pos) "\";}" (subr (substr str (+ 2 pos)))) ) ((and (< 80 (strlen str)) (setq pos (vl-string-position 32 (substr str 1 80) nil t))) (strcat ":text_part{label=\"" (substr str 1 pos) "\";}" (subr (substr str (+ 2 pos)))) ) (t (strcat ":text_part{label=\"" str "\";}")) ) ) ;; Créer un fichier DCL temporaire (setq temp (vl-filename-mktemp "Tmp.dcl") file (open temp "w") ret "" ) ;; Ecrire le fichier (write-line (strcat "InputBox:dialog{key=\"box\";initial_focus=\"val\";spacer;:paragraph{" (subr msg) "}spacer;:edit_box{key=\"val\";edit_width=120;allow_accept=true;} spacer;ok_cancel;}" ) file ) (close file) ;; Ouvrir la boite de dialogue (setq dcl_id (load_dialog temp)) (if (not (new_dialog "InputBox" dcl_id)) (exit) ) (set_tile "box" box) (set_tile "val" val) (action_tile "accept" "(setq ret (get_tile \"val\")) (done_dialog)") (start_dialog) (unload_dialog dcl_id) ;;Supprimer le fichier (vl-file-delete temp) ret ) (defun gc:getcustombykey (key / val) (vl-catch-all-apply '(lambda () (vla-getcustombykey (vla-get-summaryinfo (vla-get-activedocument (vlax-get-acad-object))) key 'val) ) ) val ) ;;; Commande sauve_repertoire_bloc ;;;Invite l'utilisateur à choisir un sous répertoire qui sera sauvegarder dans le fichier (boites de dialogue) (defun c:sauve_repertoire_bloc (/ dirbox rep) (defun dirbox (txt / cdl rep) (if (setq cdl (vlax-create-object "Shell.Application")) (progn (and (setq rep (vlax-invoke cdl 'browseforfolder 0 txt 512 "")) (setq rep (vlax-get-property (vlax-get-property rep 'self) 'path)) ) (vlax-release-object cdl) ) ) rep ) (setq repertoirebloc (gc:getcustombykey "REPERTOIRE_BLOC")) (if (= repertoirebloc "...") (prompt "\nIL N'Y A PAS DE REPERTOIRE POUR LES BLOCS :") (prompt (strcat "\nLA VALEUR ACTUELLE DE REPERTOIRE_BLOC EST :" repertoirebloc " ")) ) (princ) (princ) (setq rep (dirbox "CHSOISISSEZ UN REPERTOIRE OU SERONT RECHERCHES / SAUVEGARDES LES BLOCS DU DESSIN.")) (setcustombykey1 "REPERTOIRE_BLOC" rep) (princ) ) (defun setcustombykey (key val) (vl-load-com) (not (vl-catch-all-apply '(lambda () (vla-addcustominfo (vla-get-summaryinfo (vla-get-activedocument (vlax-get-acad-object))) key val) ) ) ) ) (defun setcustombykey1 (key val) (vl-load-com) (not (vl-catch-all-apply '(lambda () (vla-setcustombykey (vla-get-summaryinfo (vla-get-activedocument (vlax-get-acad-object))) key val) ) ) ) )

HELLO la fonction "CONTROLE" permet de de controler et corriger un fichier dwg, ca OK mais des fois il dit corriger et les erreurs sont toujours la, on a beau refaire la manip, c'est toujours pareil. avec Un lips peut on savoir sur quelles entités autocad a trouvé des erreurs et fait de soit disantes corrections, et les extraires en wbloc pour mieux les visualiser, ou décider de les effacer carrement : pour soient les refaire ensuite, ou réimplanter les blocs merci Phil

hello Patrick dommage ca va etre compliqué a comprendre et analyser ! bon je verrais... Merci, bonne journée, Phil

hello Openit voici un lisp pour mettre a l'echelle positive que tu veux sur tous les blocs sélectionnés ; ---------------------------------- ; CHANGEMENT D'ECHELLE DES BLOCS ; ---------------------------------- (defun c:echb_TOUT_POSITIF (/ bl) (setvar "cmdecho" 0) (setvar "dimzin" 0) (prompt "\nCLIQUER SUR LE BLOC OU LES BLOCS POUR LE CHANGEMENT D'ECHELLE :") (setq bl nil) (while (null bl) (setq bl (ssget (list (cons 0 "insert,AEC_MVBLOCK_REF"))))) (setq echx 1) (initget (+ 2)) (setq echx (getreal (strcat "\nECHELLE X <" (rtos echx 2 10) ">: "))) (if (null echx) (setq echx 1) ) (setq echy 1) (initget (+ 2)) (setq echy (getreal (strcat "\nECHELLE Y <" (rtos echy 2 10) ">: "))) (if (null echy) (setq echy echx) ) (setq echz 1) (initget (+ 2)) (setq echz (getreal (strcat "\nECHELLE Z <" (rtos echz 2 10) ">: "))) (if (null echz) (setq echz echx) ) (setq compt 0) (setq com (sslength bl)) (while (< compt com) (if (= (cdr (assoc 0 (entget (ssname bl compt)))) "INSERT") (progn (vlax-put-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'xeffectivescalefactor echx ) (vlax-put-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'yeffectivescalefactor echy ) (vlax-put-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'zeffectivescalefactor echz ) (entmod (entget (ssname bl compt))) (command-s "_attsync" "_n" (cdr (assoc 2 (entget (ssname bl compt))))) ) ) (if (= (cdr (assoc 0 (entget (ssname bl compt)))) "AEC_MVBLOCK_REF") (progn (vlax-put-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'scalex echx) (vlax-put-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'scaley echy) (vlax-put-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'scalez echz) ) ) (setq compt (1+ compt)) ) (prompt "\n") (setvar "dimzin" 8) ) et si des fois ton bloc de base avait une echelle négative parce qu'il y avait eu un miroir (defun c:echb_GARDER_NEGATIF (/ bl) (setvar "cmdecho" 0) (setvar "dimzin" 0) (prompt "\nCLIQUER SUR LE BLOC OU LES BLOCS POUR LE CHANGEMENT D'ECHELLE :") (setq bl nil) (while (null bl) (setq bl (ssget (list (cons 0 "insert,AEC_MVBLOCK_REF"))))) (setq echx 1) (initget (+ 2)) (setq echx (getreal (strcat "\nECHELLE X <" (rtos echx 2 10) ">: "))) (if (null echx) (setq echx 1) ) (setq echy 1) (initget (+ 2)) (setq echy (getreal (strcat "\nECHELLE Y <" (rtos echy 2 10) ">: "))) (if (null echy) (setq echy echx) ) (setq echz 1) (initget (+ 2)) (setq echz (getreal (strcat "\nECHELLE Z <" (rtos echz 2 10) ">: "))) (if (null echz) (setq echz echx) ) (setq compt 0) (setq com (sslength bl)) (while (< compt com) (if (= (cdr (assoc 0 (entget (ssname bl compt)))) "INSERT") (progn (if (minusp (vlax-get-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'xeffectivescalefactor ) ) (vlax-put-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'xeffectivescalefactor (- echx) ) (vlax-put-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'xeffectivescalefactor echx ) ) (if (minusp (vlax-get-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'yeffectivescalefactor ) ) (vlax-put-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'yeffectivescalefactor (- echy) ) (vlax-put-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'yeffectivescalefactor echy ) ) (if (minusp (vlax-get-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'zeffectivescalefactor ) ) (vlax-put-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'zeffectivescalefactor (- echz) ) (vlax-put-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'zeffectivescalefactor echz ) ) (entmod (entget (ssname bl compt))) (command-s "_attsync" "_n" (cdr (assoc 2 (entget (ssname bl compt))))) ) ) (if (= (cdr (assoc 0 (entget (ssname bl compt)))) "AEC_MVBLOCK_REF") (progn (if (minusp (vlax-get-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'scalex)) (vlax-put-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'scalex (- echx)) (vlax-put-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'scalex echx) ) (if (minusp (vlax-get-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'scaley)) (vlax-put-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'scaley (- echy)) (vlax-put-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'scaley echy) ) (if (minusp (vlax-get-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'scalez)) (vlax-put-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'scalez (- echz)) (vlax-put-property (vlax-ename->vla-object (cdr (car (entget (ssname bl compt))))) 'scalez echz) ) ) ) (setq compt (1+ compt)) ) (prompt "\n") (setvar "dimzin" 8) ) a+ Phil

hello MAT666 merci pour ta reponse j'ai corrigé certaines lignes (defun c:logfileexport2 (/ cmdecho logfilemode qaflags f line) (setq cmdecho (getvar "cmdecho") logfilemode (getvar "logfilemode") qaflags (getvar "qaflags") l nil ) (setvar "cmdecho" 0) (setvar "logfilemode" 1) ;purger le fichier texte (setq f (open (getvar "LogFileName") "w")) (write-line "" f) ;;; (close f) (command "FICHJOURNAC") (setvar "qaflags" 2) (setvar "cmdecho" 1) ;attention, bien vérifier que la commande est la bonne. (command "_PROPERTYSETDUMP" pause "AIRE") ;exemple de commande qui fonctionne : ;(command "_-layer" "?" "*" "") (setvar "qaflags" qaflags) (setvar "cmdecho" cmdecho) (command "FICHJOURNIN") ;transformer le fichier en liste (setq f (open (getvar "LogFileName") "R")) (while (setq line (read-line f)) (setq l (cons line l))) (close f) l ) le premier ( close f ) fait planter le lisp, je l'ai retiré en tapant "!l" j'ai la meme liste et plus merci Phil

Hello Patrick ton programme "GEF" modifie le "gel/degele de la fenetre" des calques dans les fenetres de présentations. est ce que tu aurais une version permettant la modification de la "couleur de la fenetre" du calque dans les fenetres de presentations. en gros oui je ne sais pas comment modifier GEF pour qu'il le fasse. Merci, Phil

hello pour qu'on leur donne du fric ? on va les payer en gilet jaunes, ils seraient foutue de prendre ca pour un attentat, vue de l'autre cote de l'atlantique. on va passer sur FOX NEWS. sinon c'est quoi la réponse ? surement plus subtile que ma réponse Phil

hello "VOUS POUVEZ REPETER LA QUESTION" ( elle s'appelait pas Stéphanie par hasard ? ) chercherais tu a faire la liste de tous les blocs insérés sur ton plan par "autre "hasard" ? Phil

hello je viens de tester EXL, je pensais qu'il n'allait exporter que ce qui est et dépasse dans la fenetre ou les fenetres des présentations. et virer tout ce qui est en dehors ou geler / invisible dans les fenetres. pour faire des fichiers plus petits que l original. est ce normal ? sinon je ne comprend pas quand utiliser GEXL et son utilité et sur quel fichier ? l original ou l'exportation. merci Phil

hello pourquoi devoir geler les calques une fois que l'exportation a été effectuer ? le fichier de base n'a plus droit d'etre modifier ? ou il faut plutot geler les calques avant exportation, pour que le travail s'effectue plus vite, ou sans soucis le fichier de base subit une destruction ? a+ Phil

hello GILE merciii la vérité, non je n'ai pas cherché c'est vrai ni sur le site de cadxp ( en cherchant la je trouve rien ) ni dans les fonctions visual lisp ( c'est en anglais, je chercherai un HELP sur l ordi et j'arrive deja pas a décodé le premier lisp ) a+ Phil

HELLO gile avait ecrit ca, merci a lui ca fait un zoom total dans toutes les fenetres des présentations sans devoir les ouvrir comment modifier ce lisp, pour qu'il fasse un zoom total de ce qu'il y a dans la présentation a la volée, et non pas des fenetre de la dite présentation. merci Phil ;;;------------------------------------------------------- ;;; zoom tout dans les fenetres de presentation a la volée ;;;------------------------------------------------------- (defun c:zep (/ acdoc ctab vp) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)) ctab (getvar 'ctab) ) (vlax-for layout (vla-get-Layouts acdoc) (if (/= (vla-get-Name layout) "Model") (progn (vla-put-ActiveLayout acdoc layout) (setq vp nil) (vlax-for obj (vla-get-Block layout) (if (= (vla-get-ObjectName obj) "AcDbViewport") (progn (if vp (or (= (vla-get-DisplayLocked obj) :vlax-true) (vla-put-Standardscale obj acVpScaleToFit) ) ) (setq vp T) ) ) ) ) ) ) (setvar 'ctab ctab) (princ) )

HELLO Gile c'est un TOC meme, c'est surtout un copier coller, d'autre lisp je ne suis pas programmeur a la base, puis si ca marche je ne cherche pas non plus a etre hyper puriste sur le code. tant que ca ne plante pas autocad, je fais avec et je m'énerve sinon, ( ce qui soit dit en passant ne fait pas avancer les choses ) puis tu vas me dire y'a plein d'autres lignes dans le code qui ne servent a rien, et que je n'ai pas non plus effacé. bon week end Phil

hello x_all essai ca ca devrait redistribuer dans un calque suivant le type de texte, sa couleur, sa hauteur dit moi si ca marche Phil (defun c:modifier_texte_calque_suivant_hauteur () (vl-load-com) (setvar "cmdecho" 0) (setvar "dimzin" 0) (setvar "osmode" 0) (prompt "\nCLIQUER SUR LES OBJETS A DEPLACER DE CALQUE :") (setq entites nil) (while (null entites) (setq entites (ssget '((0 . "text,mtext"))))) (setq compt 0) (setq com (sslength entites)) (while (< compt com) (progn (setq ent1 (ssname entites compt)) (setq code1 (cdr (assoc -1 (entget ent1)))) (setq ena1 (vlax-ename->vla-object code1)) (setq typeobjet (vla-get-objectname ena1)) (setq proper1 (vlax-get-property ena1 'truecolor)) (setq colorr (vlax-get-property proper1 'colorindex)) (setq ligntype (vla-get-linetype ena1)) (setq eplign (vla-get-lineweight ena1)) (setq hautexte (vla-get-height ena1)) (setq calquenew (strcat "CALQUE " typeobjet " " (rtos hautexte 2 5) " " (rtos colorr 2 0))) (if (or (= colorr 256) (= colorr 0)) (setq colorr 7) ) (if (= (tblsearch "layer" calquenew) nil) (vl-cmdf "-calque" "n" calquenew "co" colorr calquenew "in" calquenew "") ) (vla-put-layer ena1 calquenew) (vlax-put-property proper1 'colorindex 256) (vlax-put-property ena1 'truecolor proper1) (vla-put-lineweight ena1 -1) (setq compt (1+ compt)) (prompt (strcat "\rENTITE DEPLACEE : " (rtos compt 2 0) " SUR : " (rtos com 2 0) " ")) ) ) )

hello merci DIDIER oui c'etait ca, ca j'ai essayé, mais ca n'enleve que un par un dans une liste merci GEGEMATIC je teste de suite ca marche layers = liste des calques noms a soustraire : "0" "Defpoints" "ASHADE" (setq layers (vl-remove-if '(lambda (x) (member x '("0" "Defpoints" "ASHADE"))) layers)) merci Phil

hello ca fait du bien ? hoo ouii ca fait du bien, moi c'est mes voisins qui vont venir sonner un jour pour tappage GUEULANTE loll bon ba je suis pas le seul a "gueuler" dans le noir je vois Phil

bonjour en lisp je cherche a retirer une liste d'une liste j'ai la liste complete des calques et je voudrais retirer de cette liste le calque "0" "defpoint" et autres vous avez une sous routine qui fait ca SVP ?? qui pourrait marcher pour tout type de liste , pas seulement celle des calques merci Phil

hello c'est vrai ca, autant passer direct a 2020 Phil

hello grisée mais on peut ecrire ! new design? Phil

hello Patrick si tu passe par la voir au dessus merciii Phil

hello je suis tombé sur se sujet qui date, mais ca donne quoi depuis? ca a aboutit ? Phil

hello mon lisp fonctionne mais ils faut que les deux blocs soit dans le meme calque ne fait pas deux fichiers *.lsp par contre copie tout dans un seul fichier *.lsp d'ailleurs un fichier *.lsp peut contenir plein de lisp tant que les parenthèses sont bien ouvertes et refermées dans le lisp remplace (setq selinsert (ssget (list (cons 0 "INSERT") (cons 8 layerbloc)))) par (setq selinsert (ssget (list (cons 0 "INSERT") ))) ca ne verifiera plus que les blocs soient dans le meme calque mais il faut quand meme que dans les blocs il y est des attributs avec des noms en commun a+ Phil

hello il faut que les blocs soit implantés dans le meme calque commande : MDA selectionner les données a copier de l'un aux autres en cochant les cases a+ Phil (defun c:mda (/) (setvar "cmdecho" 0) (setvar "CURSORSIZE" 10) (setq osm (getvar "osmode")) (if (and (setq source (car (entsel "\nCLIQUER SUR LE BLOC DE REFERENCE : "))) (setq source (vlax-ename->vla-object source)) (= (vla-get-objectname source) "AcDbBlockReference") ) (progn (setq layerbloc (vla-get-layer source) namebloc (vla-get-effectivename source) ) ) ) (setq compt 0 propdynnom nil propdynnom2 nil propdynnom3 nil pop2 nil ) (foreach att (vlax-invoke source 'getattributes) (setq propdynnom2 (cons (cons (vla-get-tagstring att) (vla-get-textstring att)) propdynnom2)) ) (setq propdynnom (vl-sort propdynnom2 (function (lambda (p1 p2) (< (car p1) (car p2)))))) (prompt "\nSELECTIONNER LES BLOCS A MODIFIER:") (setq selinsert (ssget (list (cons 0 "INSERT") (cons 8 layerbloc)))) (setq com (sslength selinsert)) (boitepropdyn3) (foreach att (vlax-invoke source 'getattributes) (progn (if (member (vla-get-tagstring att) listeparam) (setq propdynnom3 (cons (cons (vla-get-tagstring att) (vla-get-textstring att)) propdynnom3)) ) ) ) (setvar "CURSORSIZE" 100) (setq compt 0) (acet-ui-progress-init "Avancement" com) (while (< compt com) ;;; (boiteavancement) (if (= (vla-get-effectivename (vlax-ename->vla-object (cdr (assoc -1 (entget (ssname selinsert compt)))))) namebloc ) (progn (foreach bidyn propdynnom3 (progn (setq nomprop (car bidyn) valprop (cdr bidyn) ) (foreach prop (vlax-invoke (vlax-ename->vla-object (cdr (assoc -1 (entget (ssname selinsert compt))))) 'getattributes ) (if (= (vla-get-tagstring prop) nomprop) (vla-put-textstring prop valprop) ) ) ) ) ) ) ;;; (prompt (strcat "\rENTITE(S) TRAITEE(S) : " ;;; (rtos compt 2 0) ;;; " SUR : " ;;; (rtos com 2 0) ;;; ) ;;; ) (acet-ui-progress-init (strcat "Avancement " (rtos (/ (* compt 100) (float com)) 2 2) " %") com) (acet-ui-progress-safe compt) (setq compt (1+ compt)) ) (acet-ui-progress-done) (setvar "osmode" osm) (princ) ) (defun boitepropdyn3 (/ tmp file fuzz ;;ret pn av dcl_id val) (setq tmp (vl-filename-mktemp "Tmp.dcl") file (open tmp "w") ret nil ) (write-line (strcat "DynBlkProps:dialog{label=\"Blocs dynamiques\";" " :text{label=\"Nom du bloc : \"" (vl-prin1-to-string namebloc) ";} :text{label=\"Nombre de bloc : " (itoa com) "\"; } :boxed_column{label=\"Propriétés dynamiques\";" ) file ) (foreach pn propdynnom (progn (if (= (numberp (cdr pn)) nil) (setq lab1 (strcat (car pn) " = " (cdr pn))) (setq lab1 (strcat (car pn) " = " (rtos (cdr pn) 2))) ) (write-line (strcat ":row{:toggle {key = \"" (car pn) "\"; label =" (vl-prin1-to-string lab1) ";}}") file ) ) ) (write-line "}spacer;ok_cancel;}" file) (close file) (setq dcl_id (load_dialog tmp)) (if (not (new_dialog "DynBlkProps" dcl_id)) (exit) ) (action_tile "accept" "(foreach p propdynnom (if (assoc (car p ) POP2) (setq val (nth (atoi (get_tile (car p ))) (cdr (assoc (car p ) POP2)))) (setq val (get_tile (car p )))) (if (and val (/= val \"\")) (setq ret (cons (cons (car p ) val) ret))) ) (and (not ret) (setq ret T)) (done_dialog)" ) (action_tile "cancel" "(setq ret nil)") (start_dialog) (unload_dialog dcl_id) (vl-file-delete tmp) (setq listeparam nil) (foreach p ret (if (= (atoi (cdr p)) 1) (setq listeparam (cons (car p) listeparam)) ) ) )

hello tu peux aussi sauvegarder des variables ou autres dans le fichier *.cfg d'autocad pour lire une variable sauvegarde precedement si elle n'existe pas dans le *.cfg prendra la valeur "0" (setq hachsurplushorizontal (atof (getcfg "APPDATA/HACHSURPLUSHORIZONTAL"))) (setq tmp (getdist (strcat "\nENTRER LA VALEUR DE DECALAGE HORIZONTAL POUR LE POINT D'ORIGINE DE LA HACHURE <" (rtos hachsurplushorizontal 2 8) ">: " ) ) ) (if tmp (setq hachsurplushorizontal tmp) ) pour sauvegarder la valeur de la variable dans le fichier *.cfg (setcfg "APPDATA/HACHSURPLUSHORIZONTAL" (rtos hachsurplushorizontal 2 8)) tu change le "HACHSURPLUSHORIZONTAL" par ce que tu veux du moment que tu es récupéré sa valeur a+ Phil