PHILPHIL
Membres-
Compteur de contenus
1 256 -
Inscription
-
Dernière visite
-
Jours gagnés
10
Type de contenu
Profils
Forums
Calendrier
Blogs
Tout ce qui a été posté par PHILPHIL
-
hello en changeant l’échelle de 15 a 1 des hachures sélectionnées par la fonction "similaire" oui je la vois a l'écran maintenant Phil
-
hello meme chose que Didier rien qui "déborde" a gauche Phil
-
hello c'est pas lier au " COVid 2019 SerVice" ce truc ?? met un masque. ou boire un coup de gel. okok je sors. BONNE année Phil
-
Objet superposé à supprimer
PHILPHIL a répondu à un(e) sujet de benoitlacroix dans LISP et Visual LISP
hello la fonction "OVERKILL" ca ne marche pas ? Phil -
rajouter les VARIABLES GLOBALES
PHILPHIL a répondu à un(e) sujet de PHILPHIL dans Pour aller plus loin en LISP
3800 lisp a reprendre donc mouai ca va rester comme ca -
rajouter les VARIABLES GLOBALES
PHILPHIL a répondu à un(e) sujet de PHILPHIL dans Pour aller plus loin en LISP
hello Luna merci j'ai utilisé cette astuce, pour quelque lisp. réponse : donc a la MANO Phil -
Hello j'ai écrit beaucoup de lisp sans jamais mettre les variables globales entre les guillements apres le defun c'est grave docteur ??? les puristes de la prog me diront que "oui" ces variables non effacées apres la fin du lisp doivent bien prendre un peu de place quelque part. est ce que je peux remédier a ca facilement par du code, avez vous programme qui réécrirait les variables globales a la bonne place en fin de ligne defun ?? j'utilise VISUAL LISP pour autocad ou VISUAL STUDIO CODE fait il ca automatiquement ?? ou alors je dois le faire manuellement ? pour les lisp aillant bcp de variable (defun c:toto_par_ci_par_la ( / variable_globale ) ) merci Phil
-
recuperer les données d'une entite dans un bloc dynamique ou pas
PHILPHIL a répondu à un(e) sujet de PHILPHIL dans Routines LISP
Hello merci tous c'est le fait de ne pas avoir cocher la case "afficher la valeur de la référence de bloc" qui faisait que ca ne marchait pas. et donc pas besoin de programmation avec le champ a+ Phil -
recuperer les données d'une entite dans un bloc dynamique ou pas
PHILPHIL a répondu à un(e) sujet de PHILPHIL dans Routines LISP
hello didier j'ai du mal m'exprimer donc ce n'est pas la donnée du parametre linéaire que je voudrais récupérer. ca je l utilise dans mes tableaux. sans probleme comme tu le montres. mais la longueur d'une polyligne ( non rectiligne ) a l'intérieur du bloc qui a justement été étirer par plusieurs parametres linéaire. a+ Phil -
recuperer les données d'une entite dans un bloc dynamique ou pas
PHILPHIL a posté un sujet dans Routines LISP
bonjour J'ai un bloc paramétrique avec plusieurs entites et UNE polyligne dans un calque bien spécifique ( plus facile a trouver comme ca ) je modifie ce bloc en etirant cette polyligne et les autres entités. je voudrais apres coup passer en revue tous les blocs sélectionner, et pour chaque bloc récupérer la longueur de cette polyligne, pour l'injecter dans un attribut de mon bloc. avec vous un exemple pour récupérer les données d'une entité bien spécifique dans un bloc en gros. j'ai essayer de mettre un champ récuperant cette longueur dans mon attribut. mais ca ne le met pas a jour j'ai bien un champ de la longueur de la polyligne dans un texte qui se met a jour lui, mais on ne peut pas récupérer les informations d'un champ dans les extraction de données. merci a+ Phil -
hello bevi une réinstallation Phil
-
hello lee mac a ecrit DIMOVERLAP ca cherche les cotations superposées. mais ca prend en compte direct TOUTES LES COTATIONS. qui pourrait me dire ou changer le lisp pour sélectionner des cotations par un ssget par exemple. ca permetrait aussi qu'il ne bosse pas avec les cotations a l'interieur des blocks. ou sur des cotes qui sont a 10 000 unites l une de l'autre merci Phil ;;-----------------------=={ Dimension Overlap }==----------------------;; ;; ;; ;; This program will automatically detect overlapping dimensions in ;; ;; all layouts and all blocks in a drawing, and will move such ;; ;; dimensions to a separate layer specified in the code. ;; ;;----------------------------------------------------------------------;; ;; Author: Lee Mac, Copyright © 2015 - www.lee-mac.com ;; ;;----------------------------------------------------------------------;; ;; Version 1.0 - 2015-12-12 ;; ;; ;; ;; - First release. ;; ;;----------------------------------------------------------------------;; ;; Version 1.1 - 2015-12-31 ;; ;; ;; ;; - dimoverlap:processblock function rewritten to detect dimensions ;; ;; which overlap on both sides. ;; ;;----------------------------------------------------------------------;; ;; Version 1.2 - 2017-04-25 ;; ;; ;; ;; - Added parameter to allow the user to alter the tolerance for ;; ;; dimension comparison. ;; ;; - Added list of layer properties to be applied to layer assigned ;; ;; to overlapping dimensions. ;; ;;----------------------------------------------------------------------;; (defun c:dimoverlap_1_2 ( / *error* cn1 cn2 ent lay tol ) (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\nError: " msg)) ) (princ) ) (setq ;;----------------------------------------------------------------------;; ;; Program Parameters ;; ;;----------------------------------------------------------------------;; ;; Tolerance within which dimensions are deemed to overlap tol 0.01 ;; Layer properties for overlapping dimensions lay '( (002 . "H_COTE DIMOVERLAP") ;; Layer Name (062 . 5) ;; Layer Colour (1-255) (006 . "Continuous") ;; Layer Linetype (Must be loaded in drawing) (370 . -3) ;; Layer Lineweight (Default = -3, else lineweight*100 e.g. 2.11 = 211) ) ;;----------------------------------------------------------------------;; cn1 0 cn2 0 ) (LM:startundo (LM:acdoc)) (vlax-for blk (vla-get-blocks (LM:acdoc)) (if (= :vlax-false (vla-get-isxref blk)) (if (= :vlax-true (vla-get-islayout blk)) (setq cn1 (+ cn1 (dimoverlap:processblock blk (cdr (assoc 2 lay)) tol))) (setq cn2 (+ cn2 (dimoverlap:processblock blk (cdr (assoc 2 lay)) tol))) ) ) ) (if (< 0 cn2) (vla-regen (LM:acdoc) acallviewports) ) (if (< 0 (+ cn1 cn2)) (progn (if (setq ent (tblobjname "layer" (cdr (assoc 2 lay)))) (entmod (vl-list* (cons -1 ent) '(000 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") '(070 . 0) lay ) ) ) (princ (strcat "\n" (itoa (+ cn1 cn2)) " overlapping dimension" (if (= 1 (+ cn1 cn2)) " was" "s were") " found and moved to the \"" (cdr (assoc 2 lay)) "\" layer." (if (< 0 cn2) (strcat "\n" (itoa cn2) (if (= 1 cn2) " was in a block." " were in blocks.") ) "" ) ) ) ) (princ "\nNo overlapping dimensions were found.") ) (LM:endundo (LM:acdoc)) (princ) ) (defun dimoverlap:processblock ( blk lay tol / cnt dm1 dm2 enx g10 g13 g14 int lst ocs tmp vec ) (vlax-for obj blk (if (wcmatch (vla-get-objectname obj) "AcDbRotatedDimension,AcDbAlignedDimension") (progn (setq enx (entget (vlax-vla-object->ename obj)) ocs (cdr (assoc 210 enx)) g10 (trans (cdr (assoc 10 enx)) 0 ocs) g13 (trans (cdr (assoc 13 enx)) 0 ocs) g14 (trans (cdr (assoc 14 enx)) 0 ocs) ) (if (not (equal g10 g14 1e-8)) (setq vec (mapcar '- g10 g14) int (inters g10 (mapcar '+ g10 (list (- (cadr vec)) (car vec) 0.0)) g13 (mapcar '+ g13 vec) nil ) lst (cons (list g10 int enx) lst) ) ) ) ) ) (setq cnt 0) (while (setq dm1 (car lst)) (setq lst (cdr lst) tmp lst ) (while (not (or (null (setq dm2 (car tmp))) (vl-some '(lambda ( a b c d ) (cond ( (equal a c tol) (cond ( (dimoverlap:online-p b c d tol) (dimoverlap:flagdim (caddr dm2) lay) (setq cnt (1+ cnt)) ) ( (dimoverlap:online-p d a b tol) (dimoverlap:flagdim (caddr dm1) lay) (setq cnt (1+ cnt)) ) ) ) ( (and (dimoverlap:online-p c a b tol) (dimoverlap:online-p a c d tol) ) (foreach dim (list dm1 dm2) (dimoverlap:flagdim (caddr dim) lay) (setq cnt (1+ cnt)) ) ) ) ) (list (car dm1) (car dm1) (cadr dm1) (cadr dm1)) (list (cadr dm1) (cadr dm1) (car dm1) (car dm1)) (list (car dm2) (cadr dm2) (car dm2) (cadr dm2)) (list (cadr dm2) (car dm2) (cadr dm2) (car dm2)) ) ) ) (setq tmp (cdr tmp)) ) ) cnt ) (defun dimoverlap:online-p ( p a b f ) (and (not (equal a p f)) (not (equal b p f)) (equal (distance a b) (+ (distance a p) (distance b p)) f) ) ) (defun dimoverlap:flagdim ( x l ) (entmod (subst (cons 8 l) (assoc 8 x) x)) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (if (null LM:startundo) (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (if (null LM:endundo) (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (if (null LM:acdoc) (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) ) ;;----------------------------------------------------------------------;; (vl-load-com) (princ (strcat "\n:: DimensionOverlap.lsp | Version 1.2 | \\U+00A9 Lee Mac " (menucmd "m=$(edtime,0,yyyy)") " www.lee-mac.com ::" "\n:: Type \"dimoverlap_1_2\" to Invoke ::" ) ) (princ) ;;----------------------------------------------------------------------;; ;; End of File ;; ;;----------------------------------------------------------------------;;
-
hello Philsogood ca vient du fait que tu ne dois pas avoir le lisp qui defini la boite de dialogue INPUTBOX2 ;; 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 ) Phil
-
hello et mettre les hachures en arriere plan ? plus un petit "control" Phil
-
hello Barbichette un petit lisp qui modifie la ligne de cote par rapport au premier ou dernier point d'accroche de la cote. a faire sur une cote ou plusieurs ; ------------------------------------------------------- ; MODIFICATION DE LA DISTANCE DE LA LIGNE DE COTE PAR RAPPORT AU PREMIER POINT ; ------------------------------------------------------- (defun c:dico (/ dist1314 point10 point12 point13 point14 angcote longcote codempla sj2) (setvar "cmdecho" 0) (setq osm (getvar "osmode")) (setvar "osmode" 0) (setvar "PICKSTYLE" 0) (setq decacote1 (atof (getcfg "APPDATA/decacote1"))) (setq tmp (getdist (strcat "\nENTRER LE DECALAGE DE LA LIGNE DE COTE <" (rtos decacote1 2 8) ">: "))) (if tmp (setq decacote1 tmp) ) (prompt "\nCLIQUER SUR LE(S) COTE(S) A MODIFIER :") (setq entx nil) (while (null entx) (setq entx (ssget '((0 . "DIMENSION"))))) (setq compt 0) (setq com (sslength entx)) (while (< compt com) (progn (setq sj2 (entget (ssname entx compt))) (setq point10 (cdr (assoc 10 sj2)) point11 (cdr (assoc 11 sj2)) point13 (cdr (assoc 13 sj2)) point14 (cdr (assoc 14 sj2)) point15 (cdr (assoc 15 sj2)) ) ;;;(command-s "cercle" (trans point10 0 1) "5") ;;;(command-s "cercle" (trans point11 0 1) "10") ;;;(command-s "cercle" (trans point13 0 1) "20") ;;;(command-s "cercle" (trans point14 0 1) "30") ;;;(command-s "cercle" (trans point15 0 1) "40") (if (= (distance point14 point10) 0) (progn (setq sj2 (subst (cons 10 (polar point14 (/ pi 2) decacote1)) (assoc 10 sj2) sj2)) (setq sj2 (subst (cons 70 32) (assoc 70 sj2) sj2)) ) (progn (setq sj2 (subst (cons 10 (polar point14 (angle point14 point10) decacote1)) (assoc 10 sj2) sj2)) (setq sj2 (subst (cons 70 32) (assoc 70 sj2) sj2)) ) ) (entmod sj2) ) (setq compt (1+ compt)) ) (setvar "osmode" osm) (setcfg "APPDATA/decacote1" (rtos decacote1 2 8)) (princ) ) un autre lisp qui aligne la ligne des cotes par rapport a une seule ;; ----------------- ;; ALIGNE LES COTES LES AUTRES PAR RAPPORT A UNE ;; ----------------- (defun c:ca0 (/ cot-b cot-esp) (setq dtm (getvar "dimtmove")) (setvar "DIMTMOVE" 0) (setvar "PICKSTYLE" 0) (while (not cot-b) (setq cot-b (car (entsel "\nSELECTIONNEZ LA COTE DE BASE :"))) (if cot-b (if (not (equal (cdr (assoc 0 (entget cot-b))) "DIMENSION")) (setq cot-b nil) ) ) ) (prompt "\nSELECTIONNEZ LES COTES A ESPACER :") (setq cot-esp (ssget '((0 . "DIMENSION")))) (vl-cmdf "_DIMSPACE" cot-b cot-esp "" "0") (setvar "DIMTMOVE" dtm) (princ) ) Phil
-
VLisp Copier les Donnees Etendues (AutoCAD Architecture/MEP)
PHILPHIL a posté un sujet dans AutoCAD Architecture
bonjour voici un LISP pour autocad architecture qui permet de copier des données étendues entre entites placer dans le meme calque que l'entite source une définition de jeu de propriété par type d'objet est requis, sinon le lisp va s'enmeller les pinceaux je pense. a tester Phil ;;;--------------------------------------------------------- ;;;copier des données étendues d une entites a dautres ;;;--------------------------------------------------------- (defun c:copier_donnee_etendue ( / COM COMPT DIC DICO1 DICO2 DICOPARAVALUE DICOPARAVALUE1 LISTDONETEN LISTDONETEN1 NOMPROP OBJ OSM PROPERTIES2 PROPSET2 PROPSETS PSD SCHEDAPP SELINSERT TYPEOBJ VALPROP VLAOBJ ) (setvar "cmdecho" 0) (setq osm (getvar "osmode")) (setq table1 (ssget "X" (list (cons 0 "AEC_SCHEDULE_TABLE")))) (if (/= table1 nil) (progn (setq compt 0) (setq com (sslength table1)) (while (< compt com) (vlax-put-property (vlax-ename->vla-object (cdr (assoc -1 (entget (ssname table1 compt))))) 'AutoUpdate 0) (setq compt (1+ compt)) ) ) ) (setq obj (entsel "CLIQUER SUR L'ENTITE DE REFERENCE : ")) (setq vlaobj (vlax-ename->vla-object (car obj))) (setq typeobj (cdr (assoc 0 (entget (car obj)))) TYPECALK (cdr (assoc 8 (entget (car obj)))) ) (setq acadobj (vlax-get-acad-object)) (setq schedapp (vla-getinterfaceobject acadobj "AecX.AecScheduleApplication.8.5")) (setq propsets (vlax-invoke-method schedapp 'propertysets vlaobj)) (setq psd (dictsearch (namedobjdict) "AEC_PROPERTY_SET_DEFS")) (setq dico1 nil) (foreach ele psd (if (= (car ele) 3) (setq dico1 (cons (cdr ele) dico1)) ) ) (setq dico2 nil) (foreach di dico1 (if (/= (vlax-invoke-method propsets 'item di) nil) (setq dico2 (cons di dico2)) ) ) (setq dicoparavalue nil) (foreach di2 dico2 (progn (setq propset2 (vlax-invoke-method propsets 'item di2)) (setq properties2 (vlax-get-property propset2 'properties)) (vlax-for prop properties2 (if (/= (vlax-get-property prop 'automatic) :vlax-true) (setq dicoparavalue (cons (cons (vlax-get-property prop 'name) (vlax-variant-value (vlax-get-property prop 'value))) dicoparavalue ) ) ) ) ) ) (setq dicoparavalue1 (vl-sort dicoparavalue (function (lambda (p1 p2) (< (car p1) (car p2)))))) (prompt "\nSELECTIONNER LES ENTITES A MODIFIER:") (setq selinsert (ssget (list (cons 0 typeobj) (cons 8 typeCALK) ))) (setq com (sslength selinsert)) (boitepropetendue1) ;;; (decomptedebut) (setq listdoneten1 nil) (foreach lde listdoneten (foreach dpv1 dicoparavalue1 (if (= (car dpv1) lde) (setq listdoneten1 (cons dpv1 listdoneten1)) ) ) ) (setvar "CURSORSIZE" 100) (setq compt 0) (setq dic (nth 0 dico2)) (acet-ui-progress-init "AVANCEMENT" com) (while (< compt com) (foreach bidyn listdoneten1 (progn (setq nomprop (car bidyn) valprop (cdr bidyn) ) (command-s "_-aecpropertydataedit" (ssname selinsert compt) "" (strcat dic ":" nomprop) valprop "") ) ) (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) (if (/= table1 nil) (progn (setq compt 0) (setq com (sslength table1)) (while (< compt com) (vlax-put-property (vlax-ename->vla-object (cdr (assoc -1 (entget (ssname table1 compt))))) 'AutoUpdate -1) (setq compt (1+ compt)) ) ) ) ;;; (decomptefin) (setvar "osmode" osm) ) (defun boitepropetendue1 (/ 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=\"ENTITES A MODIFIER\";" " :text{label=\"NOM DE L'ENTITE SOURCE : \"" (vl-prin1-to-string typeobj) ";} :text{label=\"Nombre d'entites sélectionnées : " (itoa com) "\"; } :boxed_column{label=\"DONNEES ETENDUES\";" ) file ) (foreach pn dicoparavalue1 (progn (if (= (numberp (cdr pn)) nil) (setq lab1 (strcat (car pn) " = " (cdr pn))) (setq lab1 (strcat (car pn) " = " (rtos (cdr pn) 2))) ) (setq test33 (car pn)) (write-line (strcat ":row{:toggle {label =" (vl-prin1-to-string lab1) ";key = \"" (car pn) "\";value=\"0\";}}") file ) ) ) (write-line ":row{:button{key=\"tout\";label=\"TOUT\";}:button{key=\"aucun\";label=\"Aucun\";}}" 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 "tout" "(foreach pn dicoparavalue1 (set_tile (car pn) \"1\" ) )") (action_tile "aucun" "(foreach pn dicoparavalue1 (set_tile (car pn) \"0\" ))") (action_tile "accept" "(foreach p dicoparavalue1 (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 listdoneten nil) (foreach p ret (if (= (atoi (cdr p)) 1) (setq listdoneten (cons (car p) listdoneten)) ) ) ) -
Routine de Préfixe - Suffixe - Nouvelle valeur pour Données D'Objets
PHILPHIL a répondu à un(e) sujet de fabcad dans Pour aller plus loin en LISP
hello petite question de sémantique alors. et comment les récupérer ? quel est le nom des "données" sous "ligne" sous "jeux de propriétés" l'onglet s'appelle bien "donnée étendues" Phil -
PROPAGER ETAT DE CALQUE DANS LES FENETRES DE PRESENTATIONS
PHILPHIL a répondu à un(e) sujet de PHILPHIL dans Routines LISP
hello OK merci je vais regarder ca Phil -
Routine de Préfixe - Suffixe - Nouvelle valeur pour Données D'Objets
PHILPHIL a répondu à un(e) sujet de fabcad dans Pour aller plus loin en LISP
hello je suis tomber par hazard ici. je suis sous autocad architecture, ( j'ai autocad MEP non installé ) cette fonction "ADE_ODTABLELIST" sert elle a faire la liste des "données étendues" des entités ? si oui qu'elle est la fonction équivalente sous autocad architecture ? s'il y en a une bien sur. ou récupérer le *.dll / *.arx de Mep comportant cette fonction et le faire fonctionner sous autocad architecture ? sinon j'essaie de tester ca, ( si ca a quelque chose a voir car la je n'en sais rien ) (defun c:recuper_donnee_etendue () (setq vlaobj (vlax-ename->vla-object (car (entsel "Select a block: "))) acadobj (vlax-get-acad-object) schedapp (vla-getinterfaceobject acadobj "AecX.AecScheduleApplication") ;;; schedapp (vla-getinterfaceobject acadobj "AecPropDataMgd") propsets (vlax-invoke-method schedapp 'propertysets vlaobj) psdname "RoomObjects" propset (vlax-invoke-method propsets 'item psdname) properties (vlax-get-property propset 'properties) propnamevallist (reverse (vlax-for prop properties (setq propnamevallist (cons (cons (vlax-get-property prop 'name) (vlax-variant-value (vlax-get-property prop 'value))) propnamevallist ) ) ) ) ) ) mais impossible de mettre la mains sur "AecX.AecScheduleApplication" il a été remplacé par un autre *.arx ou *.dll ?? a+ Phil -
HELLO Steven oui le souci n'est pas dans la restauration mais en utilisant "MODIFIER" un etat de calque. apres modification, sauvegarde et retour a modifier, les modifs n'ont pas ete prise en compte. donc je suppose qu'il n'y a pas euy de sauvegarde des modifs. = BUG ??? Phil
-
hello je déterre le sujet. je cherchais a copier un etat de calque dans une fenetre par programmation. hors je constate un BUG. si on modifie un etat de calque apres coup, celui ci ne s'enregistre pas, les modification apporté au GEL ou pas de calques n'est pas enregistré. est ce que ca fait ca aussi chez vous ? je suis sur autocad architecture 2023. ( je n'ai pas teste sur autocad 2023 ) a+ Phil
-
PROPAGER ETAT DE CALQUE DANS LES FENETRES DE PRESENTATIONS
PHILPHIL a posté un sujet dans Routines LISP
Hello. peut on récupérer la liste des noms de l'etat de calques, pour ensuite dans une fenetre en sélectionner un, en LISP ? peut on acceder a l'espace objet d'une fenetre de présentation sans l'ouvrir ( sans devoir aller dans l'onglet de présentation en restant dans l'onglet objet ), et faire la fonction -calque pour modifier, restaurer l'etat de calque ? pour aller plus sans devoir passer en revue tous les onglets de présentations. a+ Phil -
FORCER LA COULEUR DES CALQUES DANS LES FENETRES DE PRESENTATION
PHILPHIL a posté un sujet dans Routines LISP
HELLO voici un lisp pour forcer la couleur des calques dans les fenetres de présentations sans les ouvrir. merci a Gile au passage. ca ouvre une fenêtre pour choisir les fenestres a modifier, ( repérer grâce a leurs ID ), puis une fenetre de filtre de calque, puis une fenetre de sélection des calques, puis sélection de la couleurs désirée. bizarrement sans aller dans les présentations , les ID des fenetres sont toutes à "0", une fois avoir parcourues les présentations, l'ID change et passe à "2" ( minimum). qui a la solution pour ne pas a avoir ce souci ? A+ Phil (defun c:change_couleur_des_calques_dans_fenetres (/ acdoc ss ref name new) (setq cav (getvar "clayer")) (command-s "-calque" "ch" "0" "") (setq couleur (atoi (getcfg "APPDATA/couleur"))) (setq selectfen nil listefen nil listobj nil lists1 nil compt 0 ) (setq selectfen (ssget "X" '((0 . "VIEWPORT") (-4 . "<NOT") (69 . 1) (-4 . "NOT>")))) (setq com (sslength selectfen)) (while (< compt com) (progn (setq obj (ssname selectfen compt) listobj (cons obj listobj) pre_name (cdr (assoc 410 (entget obj))) id_fen (cdr (assoc 69 (entget obj))) li1 (strcat pre_name (rtos id_fen 2 0)) ) (setq listefen (cons li1 listefen)) ) (setq compt (1+ compt)) ) (setq viewport1 (getlviewport1 listefen "CHOSISSEZ LES FENETRES A MODIFIER" t)) (setq comlistefen (length listefen)) (foreach ele viewport1 (progn (setq lists1 (cons (- comlistefen (length (member ele listefen))) lists1))) ) (setq lists1 (reverse lists1)) (setq nomlayerfiltre (getcfg "APPDATA/NOMLAYERFILTRE")) (setq boite "FILTRE DES CALQUES [ * ] POUR FILTRER AUCUN CALQUES ") (setq message "LE(S) CARACTERE(S) A FILTRER DANS LE NOM") (inputbox2 boite message nomlayerfiltre) (if (/= ret "") (setq nomlayerfiltre ret) ) (setcfg "APPDATA/NOMLAYERFILTRE" nomlayerfiltre) (setq layers (getlayers_filtre_double nil t)) ;;; (setq layers (getlayers_filtre nil t)) (setq couleurnew (acad_colordlg 1)) (setcfg "APPDATA/couleur" (rtos couleurnew 2 0)) (foreach l1 lists1 (progn (setq viewport (nth l1 listobj)) (foreach lay layers (gc-vplayeroverride viewport lay couleurnew nil -3)) ) ) (setvar "clayer" cav) (princ) ) (defun c:change_couleur_des_calques_annuler_dans_fenetres (/ acdoc ss ref name new) (setq cav (getvar "clayer")) (command-s "-calque" "ch" "0" "") (setq couleur (atoi (getcfg "APPDATA/couleur"))) (setq selectfen nil listefen nil listobj nil lists1 nil compt 0 ) (setq selectfen (ssget "X" '((0 . "VIEWPORT") (-4 . "<NOT") (69 . 1) (-4 . "NOT>")))) (setq com (sslength selectfen)) (while (< compt com) (progn (setq obj (ssname selectfen compt) listobj (cons obj listobj) pre_name (cdr (assoc 410 (entget obj))) id_fen (cdr (assoc 69 (entget obj))) li1 (strcat pre_name (rtos id_fen 2 0)) ) (setq listefen (cons li1 listefen)) ) (setq compt (1+ compt)) ) (setq viewport1 (getlviewport1 listefen "CHOSISSEZ LES FENETRES A MODIFIER" t)) (setq comlistefen (length listefen)) (foreach ele viewport1 (progn (setq lists1 (cons (- comlistefen (length (member ele listefen))) lists1))) ) (setq lists1 (reverse lists1)) (setq layers (getlayers_filtre nil t)) (foreach l1 lists1 (progn (setq viewport (nth l1 listobj)) (foreach lay layers (gc-vplayerremoveall viewport lay))) ) (setvar "clayer" cav) (princ) ) (defun c:ID_FENETRE (/ acdoc ss ref name new) (setq cav (getvar "clayer")) (setq txtech 1) (setq techl 0.01); je travaille en centimetre (if (= (tblsearch "layer" "T_ID_CENTRE FENETRE") nil) (command-s "-calque" "n" "T_ID_CENTRE FENETRE" "co" "137" "T_ID_CENTRE FENETRE" "") ) (command-s "-calque" "ch" "T_ID_CENTRE FENETRE" "") (setq selectfen nil listefen nil listobj nil lists1 nil id_fen nil compt 0 ) (setq selectfen (ssget '((0 . "VIEWPORT") (-4 . "<NOT") (69 . 1) (-4 . "NOT>")))) (setq com (sslength selectfen)) (while (< compt com) (progn (setq obj (ssname selectfen compt) listobj (cons obj listobj) pre_name (cdr (assoc 410 (entget obj))) center1 (cdr (assoc 10 (entget obj))) id_fen (cdr (assoc 69 (entget obj))) ) (command-s "TEXTE" "st" "arial" "j" "mc" center1 (rtos (/ (* 1.5 txtech) techl) 2 8) "" (rtos id_fen 2 0)) ) (setq compt (1+ compt)) ) (setvar "clayer" cav) (princ) ) ;; (gile) 03/12/07 ;; Retourne la liste des présentations choisies dans la boite de dialogue ;; ;; arguments ;; titre : titre de la boite de dialogue ou nil, défauts = Choisir la (ou les) présentation(s) ;; mult : T ou nil (pour choix multiple ou unique) (defun getlviewport1 (listefen titre mult / tmp file ret) (setq tmp (vl-filename-mktemp "tmp.dcl") file (open tmp "w") ) (write-line (strcat "getlviewport1:dialog{label=" (if titre (vl-prin1-to-string titre) (if mult "\"Choisir les présentations du fichier\"" "\"Choisir une présentation\"" ) ) ";:list_box{height = 50;key=\"lst\";multiple_select=" (if mult "true;width = 100;}:row{:retirement_button{label=\"Toutes\";key=\"all\";} ok_button;cancel_button;}}" "false;}ok_cancel;}" ) ) file ) (close file) (setq dcl_id (load_dialog tmp)) (if (not (new_dialog "getlviewport1" dcl_id)) (exit) ) (start_list "lst") (mapcar 'add_list listefen) (end_list) (action_tile "all" "(setq ret (reverse listefen)) (done_dialog)") (action_tile "accept" "(or (= (get_tile \"lst\") \"\") (foreach n (str2lst (get_tile \"lst\") \" \") (setq ret (cons (nth (atoi n) listefen) ret)))) (done_dialog)" ) (start_dialog) (unload_dialog dcl_id) (vl-file-delete tmp) (reverse ret) ) ;; 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 getlayers_filtre_double (titre mult / lay layers tmp file ret) (while (setq lay (tblnext "LAYER" (not lay))) (setq layers (cons (cdr (assoc 2 lay)) layers))) (setq layerfiltre nil) (foreach layer layers (if (wcmatch layer (strcat "*" nomlayerfiltre "*")) (setq layerfiltre (cons layer layerfiltre)) ) ) (setq layers (vl-remove-if '(lambda (x) (member x '("0" "Defpoints" "DEFPOINTS" "Ashade" "ASHADE"))) layerfiltre)) (setq layers (vl-sort layers '<) tmp (vl-filename-mktemp "tmp.dcl") file (open tmp "w") ) (write-line (strcat "getlayers:dialog{label=" (if titre (vl-prin1-to-string titre) (if mult "\"Choisir les calques du fichier\"" "\"Choisir un calque\"" ) ) ";:list_box{height = 50;width = 100;key=\"lst\";multiple_select=" (if mult "true;width = 200;}:row{:retirement_button{label=\"Toutes\";key=\"all\";} ok_button;cancel_button;}}" "false;}ok_cancel;}" ) ) file ) (close file) (setq dcl_id (load_dialog tmp)) (if (not (new_dialog "getlayers" dcl_id)) (exit) ) (start_list "lst") (mapcar 'add_list layers) (end_list) (action_tile "all" "(setq ret (reverse layers)) (done_dialog)") (action_tile "accept" "(or (= (get_tile \"lst\") \"\") (foreach n (str2lst (get_tile \"lst\") \" \") (setq ret (cons (nth (atoi n) layers) ret)))) (done_dialog)" ) (start_dialog) (unload_dialog dcl_id) (vl-file-delete tmp) (reverse ret) ) -
Renommer un block anonyme (ex : *A40)
PHILPHIL a répondu à un(e) sujet de Syl2007 dans Routines LISP
hello Sylvain je viens de renommer ton bloc *U1 en toto il est ensuite transformable, éditable, déplacable ( meme en *U1 ) sinon un lisp pour renommer un bloc ;;; Renomme le bloc sélectionné avant ou après le lancement de la commande (defun c:renommer_bloc (/ acdoc ss ref name new) (vl-load-com) (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (if (and (= 1 (getvar "pickfirst")) (setq ss (ssget "_I" '((0 . "INSERT")))) (eq 1 (sslength ss))) (sssetfirst nil nil) (progn (sssetfirst nil nil) (while (not (setq ss (ssget "_:S:E" '((0 . "INSERT"))))))) ) (setq ref (vlax-ename->vla-object (ssname ss 0))) (if (vlax-property-available-p ref 'effectivename) (setq name (vla-get-effectivename ref)) (setq name (vla-get-name ref)) ) (setq bloc (vla-item (vla-get-blocks acdoc) name)) (setq boite "MODIFICATION DU NOM DE BLOC") (setq message "NOUVEAU NOM") (inputbox2 boite message name) (vla-put-name bloc ret) (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 ) a+ Phil -
Changespace appliqué à toute les présentations
PHILPHIL a répondu à un(e) sujet de La Lozère dans Routines LISP
hello La Lozere https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/changespace-everything-from-pspace-to-mspace/td-p/7078693 j'ai testé le lisp de la réponse 3 mais pas les autres c'est radical par contre a+, Phil
