Patrick_35

Salut Non, je n'ai pas de version qui le permette et je ne compte pas le faire. Mais rien de t'empêche de tenter de le modifier pour le mettre à ta sauce. @+

Salut Et avec JAV ? @+

Salut Tu peux t'inspirer de CAT. @+

Salut Si, avec les calques. @+

Salut Denis Essaye ceci (entget (car (nentsel))) Et si tu ne souhaites pas sélectionner les textes du xref, il reste plus qu'a faire une boucle pour analyser le xref afin de retrouver les textes. ps : Dans autocad, xref = bloc que l'on retrouve dans la table des blocs. @+

Je suis content que tu y sois arrivé :D Comme c'était aussi un exercice pour moi, voici une version de démo. (defun c:demo(/ doc ent hac select) (defun select(/ ent lst sel) (vlax-for ent (setq sel (vla-get-activeselectionset doc)) (setq lst (cons ent lst)) ) (vla-delete sel) lst ) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (princ "\nSélectionnez une 1ere poly fermé pour hachure.") (and (ssget) (progn (setq hac (vla-addhatch (vla-get-modelspace doc) acHatchPatternTypePredefined "SOLID" :vlax-true)) (vlax-invoke hac 'appendouterloop (select)) (princ "\nSélectionnez une 2em poly fermé pour ilot.") (and (ssget) (vlax-invoke hac 'appendinnerloop (select)) ) (princ "\nSélectionnez une 3em poly fermé pour étendre la hachure.") (and (ssget) (vlax-invoke hac 'insertloopat (vla-get-numberofloops hac) acHatchLoopTypeDefault (select)) ) (vlax-invoke hac 'evaluate) ) ) (vla-endundomark doc) (princ) ) @+

Salut Comme l'indique Olivier Eckmann, c'est avec AppendInnerLoop Et en prime, un exemple pour faire une hachure sur plusieurs poly fermées. (defun c:test(/ doc ent hac lst obj sel) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (and (ssget) (progn (vlax-for ent (setq sel (vla-get-activeselectionset doc)) (setq lst (cons ent lst)) ) (vla-delete sel) (setq hac (vla-addhatch (vla-get-modelspace doc) acHatchPatternTypePredefined "SOLID" :vlax-false)) (vlax-invoke hac 'appendouterloop lst) (and (ssget) (progn (setq lst nil) (vlax-for ent (setq sel (vla-get-activeselectionset doc)) (setq lst (cons ent lst)) ) (vla-delete sel) (setq obj (vlax-make-safearray vlax-vbObject (cons 0 (1- (length lst))))) (vlax-safearray-fill obj lst) (vla-insertloopat hac (vla-get-numberofloops hac) acHatchLoopTypeDefault obj) ) ) (vlax-invoke hac 'evaluate) ) ) (vla-endundomark doc) (princ) ) 1) Tu sélectionnes une 1ere poly (ou un ensemble d'objets lignes, arcs, etc.…) 2) Une première hachure se créé. 3) Tu sélectionnes une 2em poly (ou un ensemble d'objets lignes, arcs, etc.…) 4) La hachure s'étend maintenant au nouvel objet. 5) Je te laisse faire pour AppendInnerLoop. @+

Salut Pourquoi utiliser ssname alors que tu as directement activeselectionset Par exemple (ssget "_x") (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))) (vla-get-count sel) (vla-item sel 0) (vlax-for obj sel (terpri) (princ (vla-get-objectname obj)) ) (vla-delete sel) Et je pense que cela va résoudre ton problème de vsel (vlax-invoke ... (list vsel)) @+

Oui, c'est pour montrer d'où vient le problème. On peut très bien voir des objets invisible dans le dessin sans que cela dépendent des calques. @+

Salut Avec la commande insérer --> Parcourir Il te demande si tu veux le redéfinir ou pas. Avec le DésignCenter --> Clic droit sur le bloc --> Redéfinir @+

Alors, tu dois avoir un lisp qui a cette fonction. Fait une recherche sur l'ordi de tout les *.lsp contenant le texte c:bb (en espérant que ce n'est pas dans un vlx) Et si tu n'as rien comme résultat, une recherche sur tout les fichiers contenant le texte c:bb, car on peut très bien changer l'extension d'un lisp et le charger avec l'extension modifié (c'est tordu, mais ça marche) @+

Salut J'ai ouvert ton dessin avec juste le message pour les références non résolues. Tu as ce sujet qui évoque des pistes pour charger automatiquement un lisp. Le plus simple est de mettre à dispo le lisp bb afin de voir ce qui cloche. @+

Salut En lisp, il est possible de rendre un bloc invisible. Par exemple (defun c:test(/ ent) (setq ent (vlax-ename->vla-object (car (entsel)))) (vla-put-visible ent :vlax-false) (princ "\nLe bloc est maintenant invisible.") (getstring "\nAppuyez sur entrée pour continuer...") (vla-put-visible ent :vlax-true) (princ "\nLe bloc est maintenant visible.") (princ) ) @+

Salut Comme c'est la nouvelle année, voici une fonction qui sélectionne le/les blocs, même imbriqués. L'idée est de parcourir la table des blocs, de regarder dans chaque bloc si tu as un bloc recherché imbriqué --> Oui, je le mémorise et je relance la recherche pour voir si le bloc trouvé n'est pas lui-même imbriqué dans un autre bloc. Voici la fonction et si tu as des questions, n'hésite pas. (defun rech(bl / doc ent js lst obj old sel tab nombl) (defun nombl(bl) (if (vlax-property-available-p bl 'effectivename) (strcase (vla-get-effectivename bl)) (strcase (vla-get-name bl)) ) ) (setq doc (vla-get-activedocument (vlax-get-acad-object)) bl (mapcar 'strcase bl) old bl js (ssadd) ) (while bl (setq lst nil) (vlax-for obj (vla-get-blocks doc) (and (eq (vla-get-islayout obj) :vlax-false) (eq (vla-get-isxref obj) :vlax-false) (not (wcmatch (vla-get-name obj) "*|*")) (vlax-for ent obj (and (eq (vla-get-objectname ent) "AcDbBlockReference") (vl-position (nombl ent) bl) (not (vl-position (nombl obj) lst)) (setq lst (cons (nombl obj) lst) tab (cons (vla-get-name obj) tab) ) ) ) ) ) (setq bl lst) ) (setq tab (append tab old)) (and (ssget "_x" (list (cons 0 "insert") (cons 2 (strcat (apply 'strcat (mapcar '(lambda(x)(strcat x ",")) tab)) "`*U*")))) (progn (vlax-for obj (setq sel (vla-get-activeselectionset doc)) (and (vl-position (nombl obj) tab) (ssadd (vlax-vla-object->ename obj) js) ) ) (vla-delete sel) (sssetfirst nil js) ) ) js ) Pour lancer la fonction. Tu peux indiquer une liste de blocs. La sélection est effectuée dans Autocad et tu as comme message de retour, la sélection. Par exemple (rech '("grille")) @+

Bonjour Bonne année et surtout bonne santé pour vous et vos proches. @+

Salut Oui, c'est exact. Je n'avais jamais remarqué et ce n'est pas logique. On sélectionne un bloc, puis modifbloc et on note l'ename d'un objet. On sort de l'éditeur. On sélectionne un autre bloc (mais le même nom que le précédent, juste une autre insertion), puis modifbloc, on regarde l'ename du même objet qu'auparavant, et ce n'est pas le même... Maintenant, je ne vois pas en quoi cela peut-être un problème. Si dans un dessin, tu fais pas exemple (setq ent (vlax-ename->vla-object (car (nentsel)))) (vla-delete ent) Puis un regen, l'objet sélectionné est bien effacé sur tous mes blocs. @+

Salut En partant sur les valeurs définies avec ddunits (ou commande unites ou les variables lunits et luprec) (defun c:tha(/ deb def dmz doc lay lst nbx nby new tab tbl rch_hachures) (defun rch_hachures(/ def lgn lst obj tab) (vlax-for obj (vla-get-blocks doc) (and (eq (vla-get-objectname obj) "AcDbBlockTableRecord") (eq (vla-get-isxref obj) :vlax-true) (progn (setq lst nil) (vlax-for ent obj (and (eq (vla-get-objectname ent) "AcDbHatch") (or (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-area (list ent))) (if (setq def (assoc (vla-get-layer ent) lst)) (setq lst (subst (list (car def) (+ (cadr def) (vla-get-area ent))) def lst)) (setq lst (cons (list (vla-get-layer ent) (vla-get-area ent)) lst)) ) ) ) ) (and lst (setq lgn (+ (strlen (vla-get-name obj)) 2) lst (mapcar '(lambda(x)(list (if (= (car x) "0") "0" (substr (car x) lgn) ) (cadr x) ) ) lst ) tab (cons (list (vla-get-name obj) (vl-sort lst '(lambda(a B)(< (strcase (car a)) (strcase (car B)))))) tab) ) ) ) ) ) (vl-sort tab '(lambda(a B)(< (strcase (car a)) (strcase (car B))))) ) (setq doc (vla-get-activedocument (vlax-get-acad-object)) tab (rch_hachures) tbl (apply 'append (mapcar 'cadr tab)) ) (vla-startundomark doc) (while tbl (setq deb (car tbl) tbl (cdr tbl) ) (while (setq def (assoc (car deb) tbl)) (setq deb (list (car def) (+ (cadr deb) (cadr def))) tbl (vl-remove def tbl) ) ) (setq lst (cons deb lst)) ) (setq lst (vl-sort lst '(lambda(a B)(< (car a) (car B)))) new (vla-addtable (vla-get-modelspace doc) (vlax-3d-point '(0.0 0.0 0.0)) (+ (length lst) 3) (+ (length tab) 2) 10 66 ) nbx 0 nby 0 ) (mapcar '(lambda(a B)(vlax-put new a B)) '(vertcellmargin titlesuppressed headersuppressed) '(3.0 :vlax-true :vlax-true)) (vla-settext new 0 0 "Surfaces par Calques") (repeat (length tab) (vla-settext new 1 (1+ nbx) (car (nth nbx tab))) (setq nbx (1+ nbx)) ) (repeat (length lst) (vla-settext new (+ nby 2) 0 (car (nth nby lst))) (setq nby (1+ nby)) ) (vla-settext new 1 (1+ nbx) "Total") (vla-settext new (+ nby 2) 0 "Total") (setq nbx 1 dmz (getvar "dimzin") ) (setvar "dimzin" 1) (foreach xrf tab (setq nby 2 tot 0) (foreach lay lst (and (setq def (assoc (car lay) (cadr xrf))) (setq tot (+ tot (cadr def))) (vla-settext new nby nbx (rtos (cadr def) (getvar "lunits") (getvar "luprec"))) ) (setq nby (1+ nby)) ) (vla-settext new nby nbx (rtos tot (getvar "lunits") (getvar "luprec"))) (setq nbx (1+ nbx)) ) (setq nby 2 tot 0) (foreach lay lst (vla-settext new nby nbx (rtos (cadr lay) (getvar "lunits") (getvar "luprec"))) (setq nby (1+ nby) tot (+ tot (cadr lay)) ) ) (vla-settext new nby nbx (rtos tot (getvar "lunits") (getvar "luprec"))) (setvar "dimzin" dmz) (vla-endundomark doc) (princ) ) @+

Sans un lisp, oui, car en fait, le lisp change l'origine du bloc, calcul la position de l'ancien point de base par rapport au nouveau et déplace ensuite tous les blocs vers les nouvelles positions. Ce qui fait que l'on ne voit pas de changement. @+

Salut En partant sur la base du tableau de Fraid (defun c:tha(/ deb def doc lay lst nbx nby new tab tbl rch_hachures) (defun rch_hachures(/ def lgn lst obj tab) (vlax-for obj (vla-get-blocks doc) (and (eq (vla-get-objectname obj) "AcDbBlockTableRecord") (eq (vla-get-isxref obj) :vlax-true) (progn (setq lst nil) (vlax-for ent obj (and (eq (vla-get-objectname ent) "AcDbHatch") (or (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-area (list ent))) (if (setq def (assoc (vla-get-layer ent) lst)) (setq lst (subst (list (car def) (+ (cadr def) (vla-get-area ent))) def lst)) (setq lst (cons (list (vla-get-layer ent) (vla-get-area ent)) lst)) ) ) ) ) (and lst (setq lgn (+ (strlen (vla-get-name obj)) 2) lst (mapcar '(lambda(x)(list (if (= (car x) "0") "0" (substr (car x) lgn) ) (cadr x) ) ) lst ) tab (cons (list (vla-get-name obj) (vl-sort lst '(lambda(a B)(< (strcase (car a)) (strcase (car B)))))) tab) ) ) ) ) ) (vl-sort tab '(lambda(a B)(< (strcase (car a)) (strcase (car B))))) ) (setq doc (vla-get-activedocument (vlax-get-acad-object)) tab (rch_hachures) tbl (apply 'append (mapcar 'cadr tab)) ) (vla-startundomark doc) (while tbl (setq deb (car tbl) tbl (cdr tbl) ) (while (setq def (assoc (car deb) tbl)) (setq deb (list (car def) (+ (cadr deb) (cadr def))) tbl (vl-remove def tbl) ) ) (setq lst (cons deb lst)) ) (setq lst (vl-sort lst '(lambda(a B)(< (car a) (car B)))) new (vla-addtable (vla-get-modelspace doc) (vlax-3d-point '(0.0 0.0 0.0)) (+ (length lst) 3) (+ (length tab) 2) 10 66 ) nbx 0 nby 0 ) (mapcar '(lambda(a B)(vlax-put new a B)) '(vertcellmargin titlesuppressed headersuppressed) '(3.0 :vlax-true :vlax-true)) (vla-settext new 0 0 "Surfaces par Calques") (repeat (length tab) (vla-settext new 1 (1+ nbx) (car (nth nbx tab))) (setq nbx (1+ nbx)) ) (repeat (length lst) (vla-settext new (+ nby 2) 0 (car (nth nby lst))) (setq nby (1+ nby)) ) (vla-settext new 1 (1+ nbx) "Total") (vla-settext new (+ nby 2) 0 "Total") (setq nbx 1) (foreach xrf tab (setq nby 2 tot 0) (foreach lay lst (and (setq def (assoc (car lay) (cadr xrf))) (setq tot (+ tot (cadr def))) (vla-settext new nby nbx (cadr def)) ) (setq nby (1+ nby)) ) (vla-settext new nby nbx tot) (setq nbx (1+ nbx)) ) (setq nby 2 tot 0) (foreach lay lst (vla-settext new nby nbx (cadr lay)) (setq nby (1+ nby) tot (+ tot (cadr lay)) ) ) (vla-settext new nby nbx tot) (vla-endundomark doc) (princ) ) @Fraid : Ta fonction ListeCAR2 peut-être faite aussi de cette manière (mapcar 'car Ma_liste) @+

Salut Cela indique que le lisp n'a pas trouvé la fonction GC:ATTTODYNPROP Surement, un problème de copier/coller. @+

Salut Quelque chose dans ce style ? (defun rch_hachures(/ def doc lgn lst obj tab) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vlax-for obj (vla-get-blocks doc) (and (eq (vla-get-objectname obj) "AcDbBlockTableRecord") (eq (vla-get-isxref obj) :vlax-true) (progn (setq lst nil) (vlax-for ent obj (and (eq (vla-get-objectname ent) "AcDbHatch") (or (vl-catch-all-error-p (vl-catch-all-apply 'vla-get-area (list ent))) (if (setq def (assoc (vla-get-layer ent) lst)) (setq lst (subst (list (car def) (+ (cadr def) (vla-get-area ent))) def lst)) (setq lst (cons (list (vla-get-layer ent) (vla-get-area ent)) lst)) ) ) ) ) (and lst (setq lgn (+ (strlen (vla-get-name obj)) 2) lst (mapcar '(lambda(x)(list (if (= (car x) "0") "0" (substr (car x) lgn) ) (cadr x) ) ) lst ) tab (cons (list (vla-get-name obj) (vl-sort lst '(lambda(a B)(< (strcase (car a)) (strcase (car B)))))) tab) ) ) ) ) ) (vl-sort tab '(lambda(a B)(< (strcase (car a)) (strcase (car B))))) ) @+

Salut Un oxymore ? ;) @+

Salut Bravo pour ton lisp, ce n'est pas souvent que l'on voit une proposition en vlisp. :D J'aurais deux questions. 1) Pourquoi utiliser ObjectDbx alors que les xrefs sont déjà chargés et qu'on les retrouvent dans la table des blocs ? 2) Pourquoi te limiter à 5 calques et de plus nommés alors qu'on peux facilement les retrouver grace à assoc Par exemple (if (assoc Mon_calque lst) (setq lst (subst (list Mon_calque Mes_surfaces) (assoc Mon_calque lst) lst) (setq lst (cons (list Mon_calque Mes_surfaces) lst) ) @+

Salut En informatique, le ..\ indique le répertoire parent, donc la remontée "d'un cran" dans l'arborescence du répertoire courant. Donc, un ..\..\..\Rep 2 indique une remontée de "3 crans" dans l'arborescence avant de redescendre sur le répertoire Rep 2. Pour info, le .\ indique le répertoire courant. Donc, si on souhaite conserver un chemin relatif, pas d'autres solutions. ps : pas de chemins relatifs possible entre deux lecteurs (ou drive) différents. @+

Salut Comme l'indique Demixav, tu n'as pas 50 solutions. Et pour t'éviter une addition fastidieuse, un lisp vite fait qui fait le cumul des surfaces des hachures sélectionnées. (defun c:tha(/ doc sel tot) (setq doc (vla-get-activedocument (vlax-get-acad-object)) tot 0 ) (and (ssget (list (cons 0 "HATCH"))) (progn (vlax-map-collection (setq sel (vla-get-activeselectionset doc)) '(lambda(x)(setq tot (+ tot (vla-get-area x))))) (vla-delete sel) (princ (strcat "\nTotal des surfaces des hachures : " (rtos tot))) ) ) (princ) ) @+