(gile)

Salut, Le LISP suivant supprime toutes les hachures des blocs qui ne sont pas sur le calque "Constr - Murs". Code modifié (vl-load-com) (or *acad* (setq *acad* (vlax-get-acad-object))) (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*))) (or *block* (setq *blocks* (vla-get-Blocks *acdoc*))) (or *layers* (setq *layers* (vla-get-Layers *acdoc*))) (defun c:aeropix (/ *error* name lst) (defun *error* (msg) (and msg (/= msg "Fonction annulée") (princ (strcat "\nErreur: " msg)) ) (vla-EndUndoMark *acdoc*) (princ) ) (vla-StartUndoMark *acdoc*) (vlax-for obj (vla-get-ModelSpace *acdoc*) (if (and (= (vla-get-ObjectName obj) "AcDbBlockReference") (/= (vla-get-Layer obj) "Constr - Murs") (null (member (setq name (vla-get-Name obj)) lst)) ) (setq lst (cons name lst)) ) ) (foreach n lst (setq blk (vla-item *blocks* n)) (vlax-for obj blk (if (and (= (vla-get-Lock (vla-Item *layers* (vla-get-Layer obj))) :vlax-false ) (= (vla-get-ObjectName obj) "AcDbHatch") ) (vla-delete obj) ) ) ) (vla-regen *acdoc* acActiveViewport) (*error* nil) )

L'utilisation de entmake à la place de command pour créer des objets (calques, polylignes) permet d'avoir un meilleur contrôle et de s'affranchir des problèmes de SCU ou d'accrochages aux objets. Essaye comme ça : (defun BboxRectangle (entity offset / pts) (vl-load-com) (vl-catch-all-apply (function (lambda (/ ll ur pt1 pt2) (if (= (type entity) 'ENAME) (setq entity (vlax-ename->vla-object entity)) ) (vla-GetBoundingBox entity 'll 'ur) (setq pt1 (vlax-safearray->list ll) pt1 (list (- (car pt1) offset) (- (cadr pt1) offset)) pt2 (vlax-safearray->list ur) pt2 (list (+ (car pt2) offset) (+ (cadr pt2) offset)) pts (list pt1 (list (car pt2) (cadr pt1)) pt2 (list (car pt1) (cadr pt2))) ) ) ) ) pts ) (defun c:BoxBlocAttrib (/ ss i decal pts) (if (setq ss (ssget '((0 . "INSERT") (66 . 1)))) (progn (if (null (tblsearch "LAYER" "Rectangle")) (entmake '( (0 . "LAYER") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "Rectangle") (70 . 0) (62 . 3) (6 . "Continuous") ) ) ) (or (setq decal (getdist "\nDécalage ? <10> : ")) (setq decal 10.) ) (repeat (setq i (sslength ss)) (if (setq pts (BboxRectangle (ssname ss (setq i (1- i))) decal)) (entmake (append '( (0 . "LWPOLYLINE") (100 . "AcDbEntity") (8 . "Rectangle") (100 . "AcDbPolyline") (90 . 4) (70 . 1) ) (mapcar '(lambda (x) (cons 10 x)) pts) ) ) ) ) ) ) (princ) )

Salut, Regarde cette réponse.

Toute l'aide aux développeurs est accessible depuis cette page (à mettre dans ses 'favoris'). Les fonctions LISP sont dans la rubrique AutoLISP: Reference. Pour les propriétés (vlax-get-property/vlax-put-property) et les méthodes (vlax-invoke-method) COM/ActiveX, c'est dans la rubrique ActiveX: Reference Guide. Concernant la syntaxe "Visual LISP", tu peux aussi voir ce sujet.

Re, Ligne de repère : (cdr (assoc 3 (entget (car (entsel))))) Ligne de repère multiple : (cdr (assoc 2 (entget (cdr (assoc 343 (entget (car (entsel))))))))

Salut Ligne de repère : (getpropertyvalue (getpropertyvalue (car (entsel)) "DimensionStyle") "Name") Ligne de repère multiple : (getpropertyvalue (getpropertyvalue (car (entsel)) "MLeaderStyle") "Name")

@TopSig Je ne pas vraiment aider, je n'ai jamais fait ce genre de chose. Il doit être possible, depuis la méthode Initialize du plugin de faire les contrôles et de générer une exception pour arrêter le chargement de la DLL.

Salut, La commande CONVERTPOLY avec l'option Epais (ou _Heavy) permet de convertir un polyligne ("allégée") en Polyligne2d.

Voir aussi dumpallproperties / getpropertyvalue / setpropertyvalue...

Je ne vois pas en quoi le message de @didier est méprisant (ni ne connais les "pouvoirs" dont il serait pourvu). Il invite simplement à faire appel à notre propre intelligence naturelle plutôt que de s'en remettre à un robot pour apprendre ce avec quoi je ne peut être que d'accord.

@aLb1 Si je peux me permettre, ChatGpt (ou équivalent) est bien la pire méthode pour débuter en LISP. D'après ce qu'on a pu voir depuis l’avènement des "agents conversationnels" les retours de ces "IA" en programmation, et plus particulièrement avec les langages confidentiels comme AutoLISP, ne sont que très occasionnellement pertinent, et ce, uniquement quand les demandes sont suffisamment précises pour induire les réponses (autrement dit, quand l'auteur des demandes aurait été capable de fournir la réponse. Donc je plussoie @didier, pour apprendre AutoLISP, il est impératif d'avoir d'abord un bonne connaissance d'AutoCAD et il faut ensuite apprendre les bases du langage avec l'IDE fournit (VLIDE). En plus du site de @didier, on peut aussi se référer à Intoduction à AutoLISP. (disponible sur gileCAD ou sur la boutique Autodesk).

Salut, Essaye ça: (defun c:adat (/ att lst pos dec val tag nam add ss n) (if (and (setq att (car (nentsel "\nSélectionnez un attribut à modifier: ")) ) (setq lst (entget att)) (= (cdr (assoc 0 lst)) "ATTRIB") (numberp (read (setq val (cdr (assoc 1 lst))))) (setq dec (if (setq pos (vl-string-position (ascii ".") val)) (- (strlen val) pos 1) 0 ) ) (setq tag (cdr (assoc 2 lst))) (setq nam (getpropertyvalue (cdr (assoc 330 lst)) "BlockTableRecord/Name" ) ) ) (if (and (setq add (getreal "\nEntrez la valeur à ajouter ou soustraire: ") ) (princ "\nSélectionnez les blocs à modifier.") (setq ss (ssget (list '(0 . "INSERT") (cons 2 (strcat "`*U*," nam))))) (setq n 0) ) (progn (setq dz (getvar 'dimzin)) (setvar 'dimzin (Boole 4 8 (getvar 'dimzin))) (while (setq blc (ssname ss n)) (if (and (not (wcmatch (getpropertyvalue blc "ClassName") "AcDbAssociative*Array")) (= nam (getpropertyvalue blc "BlockTableRecord/Name")) (setq val (distof (getpropertyvalue blc tag))) ) (setpropertyvalue blc tag (rtos (+ val add) 2 dec)) ) (setq n (1+ n)) ) (setvar 'dimzin dz) ) ) (princ "\nL'objet sélectionné n'est pas un attribut.") ) (princ) )

Salut, Difficile, voire impossible, de répondre sans voir le code.

On peut faire plus simple avec vl-filename-directory...

Salut, En LISP, on peut récupérer l'échelle de la fenêtre flottante active avec l'expression : (caddr (trans '(0. 0. 1.) 2 3))

Salut, Tu peux télécharger ExcelAttributeSetup.exe, pour installer ExcelAttribute sur toute version d'AutoCAD depuis 2013 (il faut probablement Débloquer le fichier téléchargé).

Salut, L'installeur (LayLockSelSetup.msi) a été mis à jour pour fonctionner aussi avec AutoCAD 2025.

Salut, Je ne comprends pas bien ce que tu cherches à faire, mais un (while (and ...)) permet de boucler simplement tant qu'aucune des expressions dans le (and ...) ne renvoie pas nil. (while (and (setq pt1 (getpoint "\n -> Premier Point: ")) (if (condition pt1) (dessiner_polyligne pt1) T ) (setq pt2 (getpoint pt1 "\n -> Deuxième Point: ")) (traitement_point pt1 pt2) ) )

Salut En LISP, l'apostrophe (') est une sorte de raccourci pour la fonction quote qui sert à éviter l'évaluation de l'expression qui lui est passée en argument. '((2 . gsPoint)) est donc équivalent à : (quote ((2 . gsPoint))) Tous deux renvoient : ((2 . GSPOINT)) sans évaluer la variable gsPoint. Pour évaluer la variable gsPoint, il faut écrire : (list (cons 2 gsPoint))

Salut, RegExp utilise VBScript.

Ci-dessous une nouvelle version qui renvoie le milieu des polylignes ouvertes et le centre de gravité des polylignes fermées si celui-ci est calculable (####;#### sinon). (vl-load-com) (defun c:Statextract (/ js file_name cle f_open key_sep str_sep oldim lst_id lst_length lst_surf lst_closed lst_centroid lst_layer n ename closed centroid ) (princ "\nSélectionner les polylignes optimisées.") (while (null (setq js (ssget '((0 . "LWPOLYLINE"))))) (princ "\nSélection vide, ou ce ne sont pas des LWPOLYLINE!" ) ) ;; pour déterminer la précision des décimales que tu veux inscrire dans le fichier (command "_.ddunits" (while (not (zerop (getvar "cmdactive"))) (command pause) ) ) (setq file_name (getfiled "Nom du fichier a créer ?: " (strcat (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 3) ) "csv" ) "csv" 37 ) ) (if (null file_name) (exit) ) (if (findfile file_name) (progn (prompt "\nFichier éxiste déjà!") (initget "Ajoute Remplace annUler _Add Replace Undo") (setq cle (getkword "\nDonnées dans fichier? [Ajouter/Remplacer/annUler] <R>: " ) ) (cond ((eq cle "Add") (setq cle "a") ) ((or (eq cle "Replace") (eq cle ())) (setq cle "w") ) (T (exit)) ) (setq f_open (open file_name cle)) ) (setq f_open (open file_name "w")) ) (initget "Espace Virgule Point-virgule Tabulation _SPace Comma SEmicolon Tabulation" ) (setq key_sep (getkword "\nSéparateur [Espace/Virgule/Point-virgule/Tabulation]? <Point-virgule>: " ) ) (cond ((eq key_sep "SPpace") (setq str_sep " ")) ((eq key_sep "Comma") (setq str_sep ",")) ((eq key_sep "Tabulation") (setq str_sep "\t")) (T (setq str_sep ";")) ) (setq oldim (getvar "dimzin")) ;; pour écrire tous les zéro, même ceux qui se révèlent inutiles. (setvar "dimzin" 0) (setq lst_id '() lst_length '() lst_surf '() lst_closed '() lst_centroid '() lst_layer '() ) (repeat (setq n (sslength js)) (setq ename (ssname js (setq n (1- n))) closed (getpropertyvalue ename "Closed") centroid (if (zerop closed) (vlax-curve-getPointAtParam ename (/ (- (vlax-curve-getEndParam ename) (vlax-curve-getStartParam ename) ) 2 ) ) (vl-catch-all-apply 'pline-centroid (list ename)) ) ) (if (vl-catch-all-error-p centroid) (setq centroid '("####" "####")) ) (setq elst (entget ename) lst_id (cons (strcat "'" (cdr (assoc 5 elst))) lst_id) lst_length (cons (getpropertyvalue ename "Length") lst_length) lst_surf (cons (getpropertyvalue ename "Area") lst_surf) lst_closed (cons closed lst_closed) lst_centroid (cons centroid lst_centroid) lst_layer (cons (cdr (assoc 8 elst)) lst_layer) ) ) (foreach n (reverse (mapcar 'list (append (mapcar '(lambda (x) (strcat x str_sep)) lst_id) (list (strcat "Handle" str_sep)) ) (append (mapcar '(lambda (x) (strcat x str_sep)) lst_layer) (list (strcat "Calque" str_sep)) ) (append (mapcar '(lambda (x) (strcat (rtos x) str_sep)) lst_length) (list (strcat "Longueur" str_sep)) ) (append (mapcar '(lambda (x) (strcat (rtos x) str_sep)) lst_surf) (list (strcat "Surface" str_sep)) ) (append (mapcar '(lambda (x) (strcat (itoa x) str_sep)) lst_closed) (list (strcat "Fermée" str_sep)) ) (append (mapcar '(lambda (x) (strcat (if (numberp x) (rtos x) x ) str_sep ) ) (mapcar 'car lst_centroid) ) (list (strcat "X Centroïd" str_sep)) ) (append (mapcar '(lambda (x) (strcat (if (numberp x) (rtos x) x ) str_sep ) ) (mapcar 'cadr lst_centroid) ) (list (strcat "Y Centroïd" str_sep)) ) ) ) (write-line (apply 'strcat n) f_open) ) (close f_open) (setvar "dimzin" oldim) (prin1) ) ;; ALGEB-AREA ;; Retourne l'aire algébrique du triangle défini par 3 points 2D ;; l'aire est négative si les points sont en sens horaire (defun algeb-area (p1 p2 p3) (/ (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)) ) (* (- (car p3) (car p1)) (- (cadr p2) (cadr p1)) ) ) 2.0 ) ) ;; TRIANGLE-CENTROID ;; Retourne le centre de gravité d'un trinagle défini par 3 points (defun triangle-centroid (p1 p2 p3) (mapcar '(lambda (x1 x2 x3) (/ (+ x1 x2 x3) 3.0) ) p1 p2 p3 ) ) ;; POLYARC-CENTROID ;; Retourne une liste dont le premier élément est le centre de gravité du polyarc ;; et le second son aire algébrique (négative si la courbure est en sens horaire) ;; ;; Arguments ;; bu : la courbure du polyarc (bulge) ;; p1 : le sommet de départ ;; p2 : le sommet de fin (defun polyarc-centroid (bu p1 p2 / ang rad cen area dist cg) (setq ang (* 2 (atan bu)) rad (/ (distance p1 p2) (* 2 (sin ang)) ) cen (polar p1 (+ (angle p1 p2) (- (/ pi 2) ang)) rad ) area (/ (* rad rad (- (* 2 ang) (sin (* 2 ang)))) 2.0) dist (/ (expt (distance p1 p2) 3) (* 12 area)) cg (polar cen (- (angle p1 p2) (/ pi 2)) dist ) ) (list cg area) ) ;; PLINE-CENTROID ;; Retourne le centre de gravité d'une polyligne (coordonnées SCG) ;; ;; Argument ;; pl : nom d'entité de la polyligne (ename) (defun pline-centroid (pl / elst lst tot cen p0 p-c cen area) (setq elst (entget pl)) (while (setq elst (member (assoc 10 elst) elst)) (setq lst (cons (cons (cdar elst) (cdr (assoc 42 elst))) lst) elst (cdr elst) ) ) (setq lst (reverse lst) tot 0.0 cen '(0.0 0.0) p0 (caar lst) ) (if (/= 0 (cdar lst)) (setq p-c (polyarc-centroid (cdar lst) p0 (caadr lst)) cen (mapcar '(lambda (x) (* x (cadr p-c))) (car p-c)) tot (cadr p-c) ) ) (setq lst (cdr lst)) (if (equal (car (last lst)) p0 1e-9) (setq lst (reverse (cdr (reverse lst)))) ) (while (cadr lst) (setq area (algeb-area p0 (caar lst) (caadr lst)) cen (mapcar '(lambda (x1 x2) (+ x1 (* x2 area))) cen (triangle-centroid p0 (caar lst) (caadr lst)) ) tot (+ area tot) ) (if (/= 0 (cdar lst)) (setq p-c (polyarc-centroid (cdar lst) (caar lst) (caadr lst)) cen (mapcar '(lambda (x1 x2) (+ x1 (* x2 (cadr p-c)))) cen (car p-c) ) tot (+ tot (cadr p-c)) ) ) (setq lst (cdr lst)) ) (if (/= 0 (cdar lst)) (setq p-c (polyarc-centroid (cdar lst) (caar lst) p0) cen (mapcar '(lambda (x1 x2) (+ x1 (* x2 (cadr p-c)))) cen (car p-c) ) tot (+ tot (cadr p-c)) ) ) (trans (list (/ (car cen) tot) (/ (cadr cen) tot) (cdr (assoc 38 (entget pl))) ) pl 0 ) )

Quand tu fais des tests, tu n'y va pas avec le dos de la cuillère ! Ton dessin contient au moins une polyligne "corrompue" (probablement avec une aire algébrique nulle). J'ai modifié le code ci-dessus pour que de telles polylignes ne provoquent plus l'arrêt de la routine (elles n'auront pas de coordonnées X et Y pour le centroid)). Géométriquement, le "centroid" d'une polyligne ouverte n'a pas vraiment de sens, idem pour une polyligne fermée avec auto-intersecion.

Salut, Essaye comme ça : (vl-load-com) (defun c:Statextract (/ js file_name cle f_open key_sep str_sep oldim lst_id lst_length lst_surf lst_closed lst_centroid lst_layer n ) (princ "\nSélectionner les polylignes optimisées.") (while (null (setq js (ssget '((0 . "LWPOLYLINE"))))) (princ "\nSélection vide, ou ce ne sont pas des LWPOLYLINE!" ) ) ;; pour déterminer la précision des décimales que tu veux inscrire dans le fichier (command "_.ddunits" (while (not (zerop (getvar "cmdactive"))) (command pause) ) ) (setq file_name (getfiled "Nom du fichier a créer ?: " (strcat (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 3) ) "csv" ) "csv" 37 ) ) (if (null file_name) (exit) ) (if (findfile file_name) (progn (prompt "\nFichier éxiste déjà!") (initget "Ajoute Remplace annUler _Add Replace Undo") (setq cle (getkword "\nDonnées dans fichier? [Ajouter/Remplacer/annUler] <R>: " ) ) (cond ((eq cle "Add") (setq cle "a") ) ((or (eq cle "Replace") (eq cle ())) (setq cle "w") ) (T (exit)) ) (setq f_open (open file_name cle)) ) (setq f_open (open file_name "w")) ) (initget "Espace Virgule Point-virgule Tabulation _SPace Comma SEmicolon Tabulation" ) (setq key_sep (getkword "\nSéparateur [Espace/Virgule/Point-virgule/Tabulation]? <Point-virgule>: " ) ) (cond ((eq key_sep "SPpace") (setq str_sep " ")) ((eq key_sep "Comma") (setq str_sep ",")) ((eq key_sep "Tabulation") (setq str_sep "\t")) (T (setq str_sep ";")) ) (setq oldim (getvar "dimzin")) ;; pour écrire tous les zéro, même ceux qui se révèlent inutiles. (setvar "dimzin" 0) (setq lst_id '() lst_length '() lst_surf '() lst_closed '() lst_centroid '() lst_layer '() ) (repeat (setq n (sslength js)) (setq ename (ssname js (setq n (1- n))) centroid (vl-catch-all-apply 'pline-centroid (list ename)) ) (if (vl-catch-all-error-p centroid) (setq centroid nil) ) (setq elst (entget ename) lst_id (cons (strcat "'" (cdr (assoc 5 elst))) lst_id) lst_length (cons (getpropertyvalue ename "Length") lst_length) lst_surf (cons (getpropertyvalue ename "Area") lst_surf) lst_closed (cons (getpropertyvalue ename "Closed") lst_closed) lst_centroid (cons centroid lst_centroid) lst_layer (cons (cdr (assoc 8 elst)) lst_layer) ) ) (foreach n (reverse (mapcar 'list (append (mapcar '(lambda (x) (strcat x str_sep)) lst_id) (list (strcat "Handle" str_sep)) ) (append (mapcar '(lambda (x) (strcat x str_sep)) lst_layer) (list (strcat "Calque" str_sep)) ) (append (mapcar '(lambda (x) (strcat (rtos x) str_sep)) lst_length) (list (strcat "Longueur" str_sep)) ) (append (mapcar '(lambda (x) (strcat (rtos x) str_sep)) lst_surf) (list (strcat "Surface" str_sep)) ) (append (mapcar '(lambda (x) (strcat (itoa x) str_sep)) lst_closed) (list (strcat "Fermée" str_sep)) ) (append (mapcar '(lambda (x) (strcat (if x (rtos x) "" ) str_sep ) ) (mapcar 'car lst_centroid) ) (list (strcat "X Centroïd" str_sep)) ) (append (mapcar '(lambda (x) (strcat (if x (rtos x) "" ) str_sep ) ) (mapcar 'cadr lst_centroid) ) (list (strcat "Y Centroïd" str_sep)) ) ) ) (write-line (apply 'strcat n) f_open) ) (close f_open) (setvar "dimzin" oldim) (prin1) ) ;; ALGEB-AREA ;; Retourne l'aire algébrique du triangle défini par 3 points 2D ;; l'aire est négative si les points sont en sens horaire (defun algeb-area (p1 p2 p3) (/ (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)) ) (* (- (car p3) (car p1)) (- (cadr p2) (cadr p1)) ) ) 2.0 ) ) ;; TRIANGLE-CENTROID ;; Retourne le centre de gravité d'un trinagle défini par 3 points (defun triangle-centroid (p1 p2 p3) (mapcar '(lambda (x1 x2 x3) (/ (+ x1 x2 x3) 3.0) ) p1 p2 p3 ) ) ;; POLYARC-CENTROID ;; Retourne une liste dont le premier élément est le centre de gravité du polyarc ;; et le second son aire algébrique (négative si la courbure est en sens horaire) ;; ;; Arguments ;; bu : la courbure du polyarc (bulge) ;; p1 : le sommet de départ ;; p2 : le sommet de fin (defun polyarc-centroid (bu p1 p2 / ang rad cen area dist cg) (setq ang (* 2 (atan bu)) rad (/ (distance p1 p2) (* 2 (sin ang)) ) cen (polar p1 (+ (angle p1 p2) (- (/ pi 2) ang)) rad ) area (/ (* rad rad (- (* 2 ang) (sin (* 2 ang)))) 2.0) dist (/ (expt (distance p1 p2) 3) (* 12 area)) cg (polar cen (- (angle p1 p2) (/ pi 2)) dist ) ) (list cg area) ) ;; PLINE-CENTROID ;; Retourne le centre de gravité d'une polyligne (coordonnées SCG) ;; ;; Argument ;; pl : nom d'entité de la polyligne (ename) (defun pline-centroid (pl / elst lst tot cen p0 p-c cen area) (setq elst (entget pl)) (while (setq elst (member (assoc 10 elst) elst)) (setq lst (cons (cons (cdar elst) (cdr (assoc 42 elst))) lst) elst (cdr elst) ) ) (setq lst (reverse lst) tot 0.0 cen '(0.0 0.0) p0 (caar lst) ) (if (/= 0 (cdar lst)) (setq p-c (polyarc-centroid (cdar lst) p0 (caadr lst)) cen (mapcar '(lambda (x) (* x (cadr p-c))) (car p-c)) tot (cadr p-c) ) ) (setq lst (cdr lst)) (if (equal (car (last lst)) p0 1e-9) (setq lst (reverse (cdr (reverse lst)))) ) (while (cadr lst) (setq area (algeb-area p0 (caar lst) (caadr lst)) cen (mapcar '(lambda (x1 x2) (+ x1 (* x2 area))) cen (triangle-centroid p0 (caar lst) (caadr lst)) ) tot (+ area tot) ) (if (/= 0 (cdar lst)) (setq p-c (polyarc-centroid (cdar lst) (caar lst) (caadr lst)) cen (mapcar '(lambda (x1 x2) (+ x1 (* x2 (cadr p-c)))) cen (car p-c) ) tot (+ tot (cadr p-c)) ) ) (setq lst (cdr lst)) ) (if (/= 0 (cdar lst)) (setq p-c (polyarc-centroid (cdar lst) (caar lst) p0) cen (mapcar '(lambda (x1 x2) (+ x1 (* x2 (cadr p-c)))) cen (car p-c) ) tot (+ tot (cadr p-c)) ) ) (trans (list (/ (car cen) tot) (/ (cadr cen) tot) (cdr (assoc 38 (entget pl))) ) pl 0 ) )

On appelle toujours une fonction LISP (native ou définie avec defun) de la même façon : (nomDeLaFonction [arguments ...]) Dans ton cas : (c:fonc1)

Salut, Pas besoin d'invoquer une commande. Il existe une fonction LISP textscr.