(gile)

Salut, VBA c'est vraiment pas mon truc, mais tu n'as pas besoin de tester la valeur courante de TILEMODE, tu peux simplement faire: ThisDrawing.SetVariable "tilemode", 1 Si vraiment tu préfères ne rien faire si TILEMODE est déjà à 1 : If ThisDrawing.GetVariable("tilemode") <> 1 Then ThisDrawing.GetVariable "tilemode", 1

Merci pour ce rappel @Luna. Je me sers tellement peu de ces 'nouveaux' réseaux associatifs que je n'arrive pas à intégrer qu'ils sont aussi des blocs dynamiques... Le dernier code corrigé avec une nouvelle fonction isAssociativeArray qui évalue si une entité est un réseau associatif. ;; isAssociativeArray ;; Renvoie T, si le ename passé en argument est celui d'un réseau associatif ; nil, sinon. (defun isAssociativeArray (ename) (wcmatch (getpropertyvalue ename "ClassName") "AcDbAssociative*Array") ) ;; getEffectiveName (fonction LISP) ;; Obtient le nom effectif d'un bloc (dynamique ou statique) ;; Renvoie nil si ent n'est pas le ename d'un bloc (defun getEffectiveName (ent) (if (and (= (cdr (assoc 0 (entget ent))) "INSERT") (not (isAssociativeArray ent)) ) (getpropertyvalue (getpropertyvalue ent "BlockTableRecord") "Name" ) ) ) ;; selectBlockByName(fonction LISP) ;; Renvoie un jeu de sélection de tous les blocs (dynamiques ou statiques) de l'espace courant ;; dont le nom effectif correspond au nom passé en argument. ;; Renvoie niil si l'espace courant ne contient aucun bloc du nom spécifié ou dynamique. (defun selectBlockByName (nombloc / ss i bloc) ;; sélection de tous les blocs (if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat nombloc ",`*U*")) (cons 410 (getvar 'ctab)) ) ) ) ;; filtre des blocs dynamiques suivant leur nom effectif (repeat (setq i (sslength ss)) (setq bloc (ssname ss (setq i (1- i)))) (if (or (isAssociativeArray bloc) (/= (strcat (getEffectiveName bloc)) (strcat nombloc) ) ) (ssdel bloc ss) ) ) ) ;; renvoi de la sélection ss ) ;; ssbn (fonction LISP) ;; Renvoie un jeu de sélection de tous les blocs (dynamiques ou statiques) de l'espace courant ;; ayant le même nom que le bloc sélectionné. (defun ssbn (/ ent nombloc) ;; sélection du bloc source (while (not (and (setq ent (car (entsel "\nSéléctionnez le bloc source: "))) (setq nombloc (getEffectiveName ent)) ) ) (prompt "Sélection non valide.") ) ;; renvoi de la sélection (selectBlockByName nombloc) ) ;; SSBN (commande LISP) ;; Affiche en surbrillance (grips) le jeu de sélection de tous les blocs de l'espace courant ;; ayant le même nom que le bloc sélectionné. (defun c:SSBN () ;; affichage de la sélection (sssetfirst nil (ssbn)) (princ) )

Une bonne pratique consiste à séparer le code de la commande en plusieurs fonctions réutilisables et testables séparément. Dans ce cas : une fonction getEffectiveName déterminer le nom effectif d'une référence de bloc (dynamique ou statique) une fonction selectBlockByName pour obtenir un jeu de sélection contenant tous les blocs de l'espace courant dont le nom correspond à celui passé en argument. une fonction ssbn qui appelle selectBlockByName en lui passant le nom effectif du bloc sélectionné. une commande c:SSBN qui lance ssbn et affiche la sélection (grips). ;; getEffectiveName (fonction LISP) ;; Obtient le nom effectif d'un bloc (dynamique ou statique) ;; Renvoie nil si ent n'est pas le ename d'un bloc (defun getEffectiveName (ent) (if (= (cdr (assoc 0 (entget ent))) "INSERT") (getpropertyvalue (getpropertyvalue ent "BlockTableRecord") "Name" ) ) ) ;; selectBlockByName(fonction LISP) ;; Renvoie un jeu de sélection de tous les blocs (dynamiques ou statiques) de l'espace courant ;; dont le nom effectif correspond au nom passé en argument. ;; Renvoie niil si l'espace courant ne contient aucun bloc du nom spécifié ou dynamique. (defun selectBlockByName (nombloc / ss i bloc) ;; sélection de tous les blocs (if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat nombloc ",`*U*")) (cons 410 (getvar 'ctab)) ) ) ) ;; filtre des blocs dynamiques suivant leur nom effectif (repeat (setq i (sslength ss)) (setq bloc (ssname ss (setq i (1- i)))) (if (/= (strcat (getEffectiveName bloc)) (strcat nombloc) ) (ssdel bloc ss) ) ) ) ;; renvoi de la sélection ss ) ;; ssbn (fonction LISP) ;; Renvoie un jeu de sélection de tous les blocs (dynamiques ou statiques) de l'espace courant ;; ayant le même nom que le bloc sélectionné. (defun ssbn (/ ent nombloc) ;; sélection du bloc source (while (not (and (setq ent (car (entsel "\nSéléctionnez le bloc source: "))) (setq nombloc (getEffectiveName ent)) ) ) (prompt "Sélection non valide.") ) ;; renvoi de la sélection (selectBlockByName nombloc) ) ;; SSBN (commande LISP) ;; Affiche en surbrillance (grips) le jeu de sélection de tous les blocs de l'espace courant ;; ayant le même nom que le bloc sélectionné. (defun c:SSBN () ;; affichage de la sélection (sssetfirst nil (ssbn)) (princ) ) Les fonctions selectBlockByName et ssbn peuvent être appelées en réponse à une invite de commande "Sélectionner des objets: ". Commande: _MOVE Sélectionnez des objets: (ssbn) Séléctionnez le bloc source: <Selection set: b1> 5 trouvé(s) Sélectionnez des objets: Spécifiez le point de base ou [Déplacement] <Déplacement>: Spécifiez le second point ou <utiliser le premier point comme déplacement>:

Salut, On peut faire plus simple. La routine de Lee Mac, outre son côté quelque peu 'cryptique', date certainement d'avant la sortie d'AutoCAD 2012 et des fonctions getpropertyvalue et setpropertyvalue qui évitent d'utiliser l'interface COM/ActiveX (VBA). (defun c:ssbn (/ ent bloc nombloc ss i) ;; sélection du bloc source (while (not (and (setq ent (car (entsel "\nSéléctionnez le bloc source: "))) (= (cdr (assoc 0 (entget ent))) "INSERT") ) ) (prompt "Sélection non valide.") ) ;; récupération du nom effectif du bloc source (setq nombloc (strcat (getpropertyvalue ent "BlockTableRecord/Name"))) ;; sélection de tous les blocs dynamiques (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 (strcat nombloc ",`*U*"))) ) ) ;; filtre des blocs dynamiques suivant leur nom effectif (repeat (setq i (sslength ss)) (setq bloc (ssname ss (setq i (1- i)))) (if (/= (strcat (getpropertyvalue bloc "BlockTableRecord/Name")) nombloc ) (ssdel bloc ss) ) ) ;; affichage de la sélection (sssetfirst nil ss) (princ) )

À l'expression : (initget "Oui Non") (setq rep1 (getkword "\nContinuer ? [Oui/Non] <Oui>: ")) On peut répondre : - soit "Oui" (ou "O") ce qui met la valeur de rep1 à "Oui" ; - soit "Non" (ou "N") ce qui met la valeur de rep1 à "Non" ; - soit faire "Entrée" ce qui met la valeur de rep1 à nil. On voit donc que si l'utilisateur veut continuer rep1 est égal à "Oui" ou nil. C'est dans le traitement conditionnel de cette entrée qu'il faut prendre en compte toutes les possibilités donc écrire : (if (or (= rep1 "Oui") (null rep1)) (progn ;si la réponse est oui ou nil, (initget "Oui Non") (setq rep2 (getkword "\nConserver l'ouverture? [Oui/Non] <Oui>: ")) (if (= rep2 "Non") (setq Ouv nil) ) (FISSURE) ;la commande est renouvelée (princ) ) (progn ;sinon (command "osmode" OS) ;Réactive l'ancien mode d'acroche objets de l'utilisateur (command "AUTOSNAP" AU) ;réactive l'ancien ssnapmode de l'utilisateur (setq Ouv nil) (princ) ) ) Ou plus simplement, parce que pour "Non" il n'y a qu'une réponse possible : (if (= rep1 "Non") (progn ;si la réponse est non, (command "osmode" OS) ;Réactive l'ancien mode d'acroche objets de l'utilisateur (command "AUTOSNAP" AU) ;réactive l'ancien ssnapmode de l'utilisateur (setq Ouv nil) (princ) ) (progn ;sinon (initget "Oui Non") (setq rep2 (getkword "\nConserver l'ouverture? [Oui/Non] <Oui>: ")) (if (= rep2 "Non") (setq Ouv nil) ) (FISSURE) ;la commande est renouvelée (princ) ) )

Si tu entres l'expression suivante dans la console (ou à la ligne de commande) et que tu fais 'Entrée', quelle est la valeur de 'rep1' ? (initget "Oui Non") (setq rep1 (getkword "\nContinuer ? [Oui/Non] <Oui>: "))

La méthode AddText (vla-AddText) requiert la hauteur du texte en argument la méthode AddMText (vla-AddMText) ne requiert pas cet argument, le texte multiligne prend automatiquement la valeur courante (getvar 'textsize).

Salut, Je pense avoir commis ce LISP. Pour un texte multiligne à la place d'un texte simple (pourtant beaucoup plus léger) : (defun c:y (/ *error* space cen pt ang just rot text) (vl-load-com) (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))) ) (defun *error* (msg) (and msg (/= msg "Fonction annulée") (prompt (strcat "\nErreur : " msg)) ) (vla-EndUndoMark *acdoc*) (princ) ) (if (setq cen (getpoint "\nCentre de la cotation: ")) (progn (vla-StartUndoMark *acdoc*) (setq space (vla-get-Block (vla-get-ActiveLayout *acdoc*))) (while (setq pt (getpoint cen "\nExtémité de l'angle: ")) (setq pt (trans pt 1 0) cen (trans cen 1 0) ang (angle cen pt) ) (cond ((equal ang (* pi 0.5) 1e-9) (setq just acAttachmentPointBottomCenter rot 0.0 ) ) ((equal ang (* pi 1.5) 1e-9) (setq just acAttachmentPointTopCenter rot 0.0 ) ) ((< (* pi 0.5) ang (* pi 1.5)) (setq just acAttachmentPointMiddleRight rot (+ pi ang) ) ) (T (setq just acAttachmentPointMiddleLeft rot ang ) ) ) ;;(vla-AddLine space (vlax-3d-point cen) (vlax-3d-point pt)) (setq text (vla-AddMText space (vlax-3d-point pt) 0.0 (strcat (angtos (- (* 0.5 pi) ang)) "°"))) (vla-put-Rotation text rot) (vla-put-AttachmentPoint text just) (vla-put-InsertionPoint text (vlax-3d-point pt)) ) ) ) (*error* nil) )

Salut, Pour un traitement par lot, il y a BatchPurge.

Salut, Ça devrait répondre à ta demande: (defun c:TEST (/ countBy ssToList getLength makeTable ss inspt) (defun countBy (fun lst / f key sub acc) (setq f (eval fun)) (foreach x lst (setq acc (if (setq sub (assoc (setq key (f x)) acc)) (subst (cons key (1+ (cdr sub))) sub acc) (cons (cons key 1) acc) ) ) ) ) (defun ssToList (ss / i lst) (repeat (setq i (sslength ss)) (setq lst (cons (ssname ss (setq i (1- i))) lst)) ) ) (defun getLength (arc / lg loop) (setq lg (getpropertyvalue arc "Length")) (defun loop (lst) (cond ((null lst) "> 12") ((<= lg (car lst)) (car lst)) (T (loop (cdr lst))) ) ) (loop '(1.2 1.5 2.0 2.5 3.0 3.5 4.0 4.5 5.0 5.5 6.0 6.5 7.0 7.5 8.0 8.5 9.0 9.5 10.0 10.5 11.0 11.5 12. ) ) ) (defun makeTable (lst inspt / table count) (vl-load-com) (setq table (vla-addtable (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)) ) (vlax-3d-point inspt) (+ (length lst) 2) 2 15 50 ) ) (vla-put-TitleSuppressed table :vlax-false) (vla-setText table 0 0 "QUANTITATIF") (setq row 1) (vla-setText table row 0 "Longueur") (vla-setText table row 1 "Quantité") (foreach p lst (setq row (1+ row)) (vla-settext table row 0 (car p)) (vla-settext table row 1 (cdr p)) (vla-setcellalignment table row 0 5) (vla-setcellalignment table row 1 5) ) (vla-TransformBy table (vlax-TMatrix (append (mapcar (function (lambda (v o) (append (trans v 0 1 T) (list o)) ) ) '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.)) (trans '(0. 0. 0.) 1 0) ) '((0. 0. 0. 1.)) ) ) ) ) (if (and (setq ss (ssget "_X" (list (cons 0 "ARC")))) (setq inspt (getpoint "\nPoint d'insertion: ")) ) (makeTable (countBy 'getLength (ssToList ss)) inspt) ) (princ) )

Salut Christian, Il y avait dans le code des balises bbcode [surligneur] ... [/surligneur] datant de l'ancien CADxp qui ne sont plus reconnues comme balises dans le nouveau CADxp et apparaissaient don "en dur". J'ai corrigé le code ci-dessus, tu peux le re-copier. Ce genre d'erreur est facile à localiser avec l'éditeur Visual LISP en cochant "Arrêt sur erreur" dans le menu "Débogage", puis en relançant le code pour générer l'erreur, enfin cliquer sur "Source de la dernière interruption" dans le menu "Débogage" pour sélectionner dans le code l'expression responsable de l'erreur. voir ce screencast.

Cette "facilité" est largement due à 20 ans de pratique et de travail. On peut intégrer la routine Getblock (dans le fichier Dialog.lsp en bas de cette page) en début de routine et passer le résultat dans l'expression (entmakex ...). Dans le cas présent les polylignes sont des rectangles orientés suivant les axes X et Y. Le LISP calcule les points inférieur gauche (ll) et supérieur droit (ur) : (setq ll (apply 'mapcar (cons 'min pts)) ur (apply 'mapcar (cons 'max pts)) ) puis il détermine si le rectangle est "horizontal" ou "vertical" pour définir le point d'insertion et la rotation (ceci en fonction des instructions et du bloc fourni par @philsogood). (if (< (- (car ur) (car ll)) (- (cadr ur) (cadr ll))) (setq pt ll rot 0. ) (setq pt (list (car ll) (cadr ur)) rot (* pi 1.5) ) )

Normal, le dessin ne contient aucune polyligne rectangulaire rouge... Si tu veux avoir le résultat escompté il faut être (très) précis sur les données en entrée. (defun c:test (/ massoc isValid ss i elst pts ll ur pt rot) (defun massoc (key alst) (if (setq alst (member (assoc key alst) alst)) (cons (cdar alst) (massoc key (cdr alst))) ) ) (defun rectanglep (pts) (and (= (length pts) 4) (or (and (= (car (car pts)) (car (cadr pts))) (= (cadr (cadr pts)) (cadr (caddr pts))) (= (car (caddr pts)) (car (cadddr pts))) (= (cadr (cadddr pts)) (cadr (car pts))) ) (and (= (cadr (car pts)) (cadr (cadr pts))) (= (car (cadr pts)) (car (caddr pts))) (= (cadr (caddr pts)) (cadr (cadddr pts))) (= (car (cadddr pts)) (car (car pts))) ) ) ) ) (if (setq ss (ssget '((0 . "lwpolyline") (90 . 4) (-4 . "&") (70 . 1)) ) ) (repeat (setq i (sslength ss)) (setq elst (entget (ssname ss (setq i (1- i))))) (if (and (vl-every '(lambda (b) (zerop b)) (massoc 42 elst)) (rectanglep (setq pts (massoc 10 elst))) ) (progn (setq ll (apply 'mapcar (cons 'min pts)) ur (apply 'mapcar (cons 'max pts)) ) (if (< (- (car ur) (car ll)) (- (cadr ur) (cadr ll))) (setq pt ll rot 0. ) (setq pt (list (car ll) (cadr ur)) rot (* pi 1.5) ) ) (entmakex (list (cons 0 "INSERT") (cons 2 "registre_ailettes") (cons 10 pt) (cons 50 rot) ) ) (entdel (cdr (assoc -1 elst))) ) ) ) ) (princ) )

Au vu des éléments fournis et de ma totale méconnaissance des registres, ailettes et autres languettes, le LISP ci dessous devrait répondre ou en tout cas fornir une base modifiable. (defun c:test (/ massoc isValid ss i elst pts ll ur pt rot) (defun massoc (key alst) (if (setq alst (member (assoc key alst) alst)) (cons (cdar alst) (massoc key (cdr alst))) ) ) (defun rectanglep (pts) (and (= (length pts) 4) (or (and (= (car (car pts)) (car (cadr pts))) (= (cadr (cadr pts)) (cadr (caddr pts))) (= (car (caddr pts)) (car (cadddr pts))) (= (cadr (cadddr pts)) (cadr (car pts))) ) (and (= (cadr (car pts)) (cadr (cadr pts))) (= (car (cadr pts)) (car (caddr pts))) (= (cadr (caddr pts)) (cadr (cadddr pts))) (= (car (cadddr pts)) (car (car pts))) ) ) ) ) (if (setq ss (ssget '((0 . "lwpolyline") (62 . 1) (90 . 4) (-4 . "&") (70 . 1)) ) ) (repeat (setq i (sslength ss)) (setq elst (entget (ssname ss (setq i (1- i))))) (if (and (vl-every '(lambda (b) (zerop b)) (massoc 42 elst)) (rectanglep (setq pts (massoc 10 elst))) ) (progn (setq ll (apply 'mapcar (cons 'min pts)) ur (apply 'mapcar (cons 'max pts)) ) (if (< (- (car ur) (car ll)) (- (cadr ur) (cadr ll))) (setq pt ll rot 0 ) (setq pt (list (car ll) (cadr ur)) rot 270 ) ) (command-s "_.insert" "registre_ailettes" "_non" pt 1. 1. rot) (command-s "_.erase" (cdr (assoc -1 elst)) "")) ) ) ) )

Salut, D'abord une bière pour la faute de frappe. Ensuite, le fichier joint ne contient pas de bloc. Il faudrait préciser s'il faut remplacer les polylignes par un bloc existant ou si le programme doit créer le bloc.

L'arrière plan n'est pas imprimé, mais on peut ne l'afficher en modifiant la valeur de la variable FIELDDISPLAY.

Le "texte" est un champ dynamique, il suffit de régénérer (ou METTREAJOURCHAMP) pour que le texte reflète le changement.

Salut, Pline_Block et TotalArea ne fonctionnent pas de la même façon. Pline_Block utilise des attributs avec des champs dynamiques, Total_Area utilise des réacteurs pour mettre à jour des attributs en temps réel. Modifier le LISP TotalArea demande un bonne maitrise du langage LISP, modifier Pline_Block est moins difficile mais il faudrait connaître la version à modifier (il y en a eu de nombreuses).

Je ne comprends toujours rien à la demande. Il me semble juste que tu demandes un LISP pour pouvoir en utiliser un autre que tu trouves génial alors que tout pourrait se faire sans programmation, juste en admettant qu'un fichier DWG est un bloc potentiel et que ce fichier peut très bien avoir des propriétés dynamiques (CF le fichier Rectangle.dwg créé sans aucune programmation). Personnellement, j'abandonne...

Voir ici. Pour le reste de la question (du moins ce que je pense avoir pu comprendre malgré des explications toujours aussi confuses), on ne peut accéder aux propriétés dynamiques des définitions de bloc en LISP

Ce que tu demandes est toujours aussi incompréhensible et/ou insensé. S'il te plait poste un exemple de DWG tel qu'il est et le même DWG tel que tu voudrais qu'il soit. Ci-joint un exemple de fichier bloc dynamique qu'on peut insérer avec l'option "Parcourir..." Rectangle.dwg

Salut, L'erreur que tu as signifie qu'une fonction attend un chaîne comme argument (stringp) mais reçoit nil. Mais elle ce type d'erreur est d'autant plus difficile à localiser que tu ne déclares pas tes variables. Dans tous les cas, ton code comporte d'autres erreurs. Avec les list_box (et popup_list), les fonction get_tile, set_tile et action_tile utilisent l'indice de l'élément (base 0) sous forme de chaîne ("0", "1", "2", ...). si tu veux stocker cette valeur dans une variable de type entier (INT), il faut la convertir avec atoi dans un sens et itoa dans l'autre. Pour savoir si la boite de dialogue a été fermée avec "OK" ou "Annuler", on utilise généralement des valeurs passées à done_dialog qu'on récupère dans la valeur de retour de start_dialog. Un exemple commenté. Le DCL : armaturesboite : dialog { label = "Dessin des armatures"; : list_box { label = "Type d'armature"; key = "cléname"; list = "Cadre\nCoupleur\nEpingle\nU"; width = 15; height = 8; } ok_cancel; } Le LISP : (defun c:Dessin_des_armatures (/ id nom_arm status) (setq id (load_dialog "Boitearmatures.dcl")) (new_dialog "armaturesboite" id) ;; valeur par défaut (setq nom_arm 0) ;; afficher la valeur par défaut dans la liste (set_tile "cléname" (itoa nom_arm)) ;; mettre à jour la variable nom_arm quand un nouvel élément est sélectionné (action_tile "cléname" "(setq nom_arm (atoi $value))") ;; renvoyer 1 si la boite est fermée par OK (action_tile "accept" "(done_dialog 1)") ;; renvoyer 0 si la boite est fermée par Annuler (action_tile "cancel" "(done_dialog 0)") ;; démarrer la boite de dialgue ;; et récupérer le résultat de done_dialog dans la variable status (setq status (start_dialog)) (unload_dialog id) ;; si la boite est fermée avec OK agir en fonction de la valeur de nom_arm (if (= status 1) (cond ((= nom_arm 0) (command "_insert" "ARM-CADRE HA" p1 1 1)) ((= nom_arm 1) (command "_insert" "ARM-COUPLEUR HA" p1 1 1)) ((= nom_arm 2) (command "_insert" "ARM-EPINGLE HA" p1 1 1)) ((= nom_arm 3) (command "_insert" "ARM-U HA" p1 1 1)) ) ) (princ) )

Salut, La commande a changé de nom, elle s'appelle désormais : MODIFTEXTE (_TEXTEDIT). Voir ici.

Non, on ne peut créer des objets personnalisés qu'avec ObjectARX (C++), donc avec une version pleine.

Salut, S'il est une différence majeure entre LISP et VBA à prendre en compte par ceux qui veulent se lancer dans la programmation d'AutoCAD, c'est qu'il y a infiniment plus d'exemple de code et d'aide disponibles sur les forums en LISP qu'en VBA.