bonuscad

Pour compléter Vincent.P regarde aussi https://www.da-code.fr/quote/ Une autre remarque pour le code 62 concernant la couleur: Par défaut une entité n'a pas pas ce code, si l'on veut forcer la couleur il faut faire un (append) Mais si la couleur est déjà forcée, il faut faire un (subst) du code 62 Donc bien vérifier si ce code existe dans la liste retournée par (entget) pour bien faire l'action désirée: (subst) ou (append) NB: pour retourner au défaut ducalque on peut mettre (62 . 256) et (62 . 0) pour dubloc.

Bonjour, (append) joint des listes d'éléments, si tu fais: (append objet-a-modifier (list (cons 62 cou))) cela fonctionne. D'ailleurs quand tu l'as fait manuellement, tu as quoter ta liste : '((62 . 7)) 😉

Effectivement avec ton fichier en première instance ma routine ne fonctionne pas (rien ne se passe) Mais si j'utilise OVERKILL (tu as de nombreux sommets dupliqués, jusqu'à 4 fois), ma routine a fonctionné par la suite sans me rapprocher du zéro en origine. J'espère que mon analyse te fera avancer...

Bonsoir, Ce n'est pas (substr) qui est pour les chaîne de caractères, mais (subst) pour substituer un élément à un autre.

Bonjour Olivier, Je ne sais si ça pourra d'être d'utilité pour toi, mais j'ai fait ce code pour insérer un sommet (en boucle) sur une poly3D selon un point donné graphiquement; qu'il soit exactement sur la 3Dpoly ou proche, l'alignement du vertex impacté n'est pas changé. Le Z est interpolé. (defun l-coor2l-pt (obj lst flag / ) (if lst (cons (list (car lst) (cadr lst) (if flag (+ (if (vlax-property-available-p obj 'Elevation) (vlax-get obj 'Elevation) 0.0) (caddr lst)) (if (vlax-property-available-p obj 'Elevation) (vlax-get obj 'Elevation) 0.0) ) ) (l-coor2l-pt obj (if flag (cdddr lst) (cddr lst)) flag) ) ) ) (defun c:add_vertex-3D ( / ss AcDoc Space obj_vla l_coor last_p pt pt_vtx new_vtx prm indx flag nw_coor) (princ "\nSélection d'une polyligne non lissée") (while (null (setq ss (ssget "_+.:E:S" '((0 . "POLYLINE") (-4 . "<AND") (-4 . "&") (70 . 8) (-4 . "<NOT") (-4 . "&") (70 . 4) (-4 . "NOT>") (-4 . "AND>")))))) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (eq (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) obj_vla (vlax-ename->vla-object (ssname ss 0)) l_coor (l-coor2l-pt obj_vla (vlax-get obj_vla 'Coordinates) T) last_p (last l_coor) ) (initget 8) (while (setq pt (getpoint "\nNouveau sommet au point : ")) (setq pt_vtx (vlax-curve-getClosestPointToProjection obj_vla (trans pt 1 0) '(0 0 1) nil) new_vtx (vlax-3d-point last_p) prm (vlax-curve-getParamAtPoint obj_vla pt_vtx) indx -1 ) (cond ((and (not (equal pt_vtx (vlax-curve-getStartPoint obj_vla) 1E-08)) (not (equal pt_vtx (vlax-curve-getEndPoint obj_vla) 1E-08))) (vla-AppendVertex obj_vla new_vtx) (repeat (if (vlax-curve-isClosed obj_vla) (fix (vlax-curve-getEndParam obj_vla)) (1+ (fix (vlax-curve-getEndParam obj_vla)))) (setq indx (1+ indx)) (if (or (not (eq indx (1+ (fix prm)))) flag) (setq nw_coor (cons (vlax-curve-getPointAtParam obj_vla indx) nw_coor)) (setq nw_coor (cons pt_vtx nw_coor) indx (1- indx) flag T) ) ) (setq indx -1) (foreach e (reverse nw_coor) (vlax-put-property obj_vla 'Coordinate (setq indx (1+ indx)) (vlax-3d-point e)) ) (setq l_coor (l-coor2l-pt obj_vla (vlax-get obj_vla 'Coordinates) T) last_p (last l_coor) nw_coor nil flag nil ) (sssetfirst nil ss) ) (T (princ "\nPoint confondu à une des extrémités.")) ) (initget 8) ) (sssetfirst nil nil) (prin1) )

Bonjour, Une simplification du code pour toi. (vl-load-com) (defun c:mult-info_po2CSV ( / js file_name cle f_open key_sep str_sep oldim lst_id lst_length lst_surf lst_closed lst_centroid lst_layer lst_width 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 '() lst_width '() ) (repeat (setq n (sslength js)) (setq ename (ssname js (setq n (1- n))) obj (vlax-ename->vla-object ename) lst_id (cons (strcat "'" (vlax-get obj 'Handle)) lst_id) lst_length (cons (vlax-get obj 'Length) lst_length) lst_surf (cons (vlax-get obj 'Area) lst_surf) lst_closed (cons (vlax-get obj 'Closed) lst_closed) lst_centroid (cons (osnap (vlax-curve-getStartPoint obj) "gcen") lst_centroid) lst_layer (cons (vlax-get obj 'Layer) lst_layer) lst_width (cons (vlax-get obj 'ConstantWidth) lst_width) ) ) (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 (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))) (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_width) (list (strcat "Largeur" str_sep))) ) ) (write-line (apply 'strcat n) f_open) ) (close f_open) (setvar "dimzin" oldim) (prin1) )

@lecrabe J'ai refait la manip de copier-coller le code depuis le forum, je n'ai pas de problème d'appariement de parenthèses. Donc vérifie ta copie car je doute que ta copie fonctionne correctement et que tu puisse "jouer" avec....?!?!

Bonjour, Je te propose un code qui va modifier tes attributs concernés et placer un MTEXT avec le diamètre du tuyau au milieu de la polyligne 3D. Je ne modifie pas la polyligne3D mais lui ajoute une XDATA qui lui attribue le diamètre du tuyau en mm en tant que réel. A toi de faire ce que tu veux de cette donnée XData (modifier ta polyligne, ou exporter la donnée ou encore autre chose) Sur ton dessin cela à l'air de fonctionner, mais le traitement peut être long (forcément, tu as énormément de blocs dans ton dessin et de polylignes3D) Pour info sur ma machine cela dure environ 4mn avec le processeur qui s’emballe à 20%), mais si tu es patient cela fait le job: Autocad n'es pas planté mais il bosse... A la fin toutes tes polylignes3D concernées sont sélectionnées, tu peux donc les changer de couleur, de calque ou autre propriétés pour mieux les repérer. Cela va t-il t'avancer? (defun l-coor2l-pt (obj lst / ) (if lst (cons (list (car lst) (cadr lst) (caddr lst) ) (l-coor2l-pt obj (cdddr lst)) ) ) ) (defun make_mtext (pt rot txt lay / ) (setq nw_obj (vla-addMtext Space (vlax-3d-point pt) 0.0 txt ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation 'BackgroundFill) (list 5 0.3 5 "Réseaux_Arial" lay rot -1) ) ) (defun c:test ( / js dfzz AcDoc Space n ss ent obj_vla l_coor l_diam atts dlt_z) (while (null (setq js (ssget "_X" (list '(0 . "POLYLINE") '(-4 . "&") '(70 . 8) (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) ) ) (if (not dfzz) (setvar "USERR1" 1E-02)) (initget 4) (if (not (setq dfzz (getdist (strcat "\nRayon de recherche? <" (rtos (getvar "USERR1") 2 2) "> : ")))) (setq dfzz (getvar "USERR1")) (setvar "USERR1" dfzz) ) (if (null (tblsearch "appid" "RESEAU_TUYAUX")) (regapp "RESEAU_TUYAUX") ) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (repeat (setq n (sslength js)) (setq ss (ssadd) ent (ssname js (setq n (1- n))) obj_vla (vlax-ename->vla-object ent) l_coor (l-coor2l-pt obj_vla (vlax-get obj_vla 'Coordinates)) l_diam nil ) (mapcar '(lambda (x) (cond ( (ssget "_X" (list '(0 . "INSERT") '(2 . "IC_11_*") '(66 . 1) (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) '(-4 . "<AND") '(-4 . ">=,>=") (cons 10 (mapcar '- (list (car x) (cadr x)) (list dfzz dfzz))) '(-4 . "<=,<=") (cons 10 (mapcar '+ (list (car x) (cadr x)) (list dfzz dfzz))) '(-4 . "AND>") ) ) (setq ss (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object) ) ) ) (vlax-for blk ss (setq atts (vlax-invoke blk 'getattributes)) (foreach att atts (if (and (eq (vla-get-tagstring att) "DIAM") (/= (vla-get-textstring att) "")) (setq l_diam (vla-get-textstring att)) ) ) ) (cond (l_diam (setq dlt_z (read (substr l_diam 4))) (vlax-for blk ss (setq atts (vlax-invoke blk 'getattributes)) (foreach att atts (if (eq (vla-get-tagstring att) "Altitude_GS") (vla-put-textstring att (rtos (- (read (vla-get-textstring att)) (* 1E-3 dlt_z)) 2 2)) ) ) ) (entmod (append (entget ent) (list (list -3 (list "RESEAU_TUYAUX" (cons 1002 "{") (cons 1000 "DIAM") (cons 1040 dlt_z) (cons 1002 "}") ) ) ) ) ) (make_mtext (vlax-curve-getPointAtParam obj_vla (* 0.5 (vlax-curve-getEndParam obj_vla))) (angle '(0. 0. 0.) (vlax-curve-getfirstderiv obj_vla (* 0.5 (vlax-curve-getEndParam obj_vla)))) l_diam (vla-get-layer obj_vla) ) ) ) ) ) ) l_coor ) ) (sssetfirst nil (ssget "_X" (list '(0 . "POLYLINE") '(-4 . "&") '(70 . 8) (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) '(-3 ("RESEAU_TUYAUX")) ) ) ) (prin1) ) NB: Fait un _AUDIT de ton dessin avant car tu as beaucoup d'erreur sur tes POLY3D (option corriger les erreurs)

@lecrabe Là mon ami, tu me surprend pour un vieux de la veille comme toi... Ces possibilités existe depuis au moins la version R12, et elles existe toujours! Pour t'en convaincre lance la commande '_FILTER et dans la sélection du filtre va tout en bas de la liste. Je t'ai monté un code qui va te permettre de choisir TOUTES les options possibles pour exécuter ta requête (suivant ton CCTP) Je t'avoue que je n'ai pas tout testé les possibilités offertes, un peu la flemme...., c'est toi l’intéressé. ;; ListBox (gile) ;; Boite de dialogue permettant un ou plusieurs choix dans une liste ;; ;; Arguments ;; title : le titre de la boite de dialogue (chaîne) ;; msg ; message (chaîne), "" ou nil pour aucun ;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...) ;; flag : 0 = liste déroulante ;; 1 = liste choix unique ;; 2 = liste choix multipes ;; ;; Retour : la clé de l'option (flag = 0 ou 1) ou la liste des clés des options (flag = 2) ;; ;; Exemple d'utilisation ;; (listbox "Présentation" "Choisir une présentation" (mapcar 'cons (layoutlist) (layoutlist)) 1) (vl-load-com) (defun str2lst (str sep / pos) (if (setq pos (vl-string-search sep str)) (cons (substr str 1 pos) (str2lst (substr str (+ (strlen sep) pos 1)) sep) ) (list str) ) ) (defun ListBox (title msg keylab flag / tmp file dcl_id choice) (setq tmp (vl-filename-mktemp "tmp.dcl") file (open tmp "w") ) (write-line (strcat "ListBox:dialog{label=\"" title "\";") file ) (if (and msg (/= msg "")) (write-line (strcat ":text{label=\"" msg "\";}") file) ) (write-line (cond ((= 0 flag) "spacer;:popup_list{key=\"lst\";") ((= 1 flag) "spacer;:list_box{key=\"lst\";width=32;") (T "spacer;:list_box{key=\"lst\";width=32;multiple_select=true;") ) file ) (write-line "}ok_cancel_err;}" file) (close file) (setq dcl_id (load_dialog tmp)) (if (not (new_dialog "ListBox" dcl_id)) (exit) ) (start_list "lst") (mapcar 'add_list (mapcar 'cdr keylab)) (end_list) (action_tile "accept" "(or (= (get_tile \"lst\") \"\") (if (= 2 flag) (progn (foreach n (str2lst (get_tile \"lst\") \" \") (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice)) ) (setq choice (reverse choice)) ) (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab))) ) ) (done_dialog)" ) (start_dialog) (unload_dialog dcl_id) (vl-file-delete tmp) choice ) (defun c:sel_by_object@end ( / sel_obj js ss sel_with sel_op sel_opp sel_opn op op_begin op_end n ent pt_start pt_end) (while (null (setq sel_obj (listbox "Objets à traiter" "Choisir le type d'objet" (mapcar 'cons '("LINE" "ARC" "*POLYLINE") '("LINE" "ARC" "*POLYLINE")) 2 ) ) ) ) (while (null (setq js (ssget (list (cons 0 (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) sel_obj))) '(-4 . "<NOT") '(-4 . "&") '(70 . 112) '(-4 . "NOT>") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) ) ) (setq ss (ssadd)) (if (not dfzz) (setvar "USERR1" 1E-02)) (initget 4) (if (not (setq dfzz (getdist (strcat "\nRayon de recherche? <" (rtos (getvar "USERR1") 2 2) "> : ")))) (setq dfzz (getvar "USERR1")) (setvar "USERR1" dfzz) ) (while (null (setq sel_with (listbox "Traiter avec" "Choisir le type d'objet" (mapcar 'cons '("POINT" "INSERT") '("POINT" "INSERT")) 2 ) ) ) ) (initget "XYZ XY") (setq sel_op (getkword "\nChoisir le mode de comparaison [XYZ/XY]? <XY>: ")) (if (eq sel_op "XYZ") (setq sel_opp ">=,>=,>=" sel_opn "<=,<=,<=") (setq sel_opp ">=,>=" sel_opn "<=,<=") ) (while (null (setq op (listbox "Exclure ou Inclure avec" "Choisir l'opérande" (mapcar 'cons '("AND" "OR" "XOR" "NOT") '("AND" "OR" "XOR" "NOT")) 1 ) ) ) ) (setq op_begin (strcat "<" op) op_end (strcat op ">")) (repeat (setq n (sslength js)) (setq ent (ssname js (setq n (1- n))) pt_start (vlax-curve-getStartPoint ent) pt_end (vlax-curve-getEndPoint ent) ) (cond ((or (ssget "_X" (list (cons 0 (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) sel_with))) (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) (cons -4 op_begin) '(-4 . "<AND") (cons -4 sel_opp) (cons 10 (mapcar '- pt_start (list dfzz dfzz dfzz))) (cons -4 sel_opn) (cons 10 (mapcar '+ pt_start (list dfzz dfzz dfzz))) '(-4 . "AND>") '(-4 . "<AND") (cons -4 sel_opp) (cons 10 (mapcar '- pt_end (list dfzz dfzz dfzz))) (cons -4 sel_opn) (cons 10 (mapcar '+ pt_end (list dfzz dfzz dfzz))) '(-4 . "AND>") (cons -4 op_end) ) ) ) (ssadd ent ss) ) ) ) (if ss (sssetfirst nil ss)) (prin1) )

Si je comprend peut être votre problème, si vous étirez votre rectangle en dynamique celui ci peut prendre la forme d'un trapèze. Si c'est le cas, ce que vous pouvez faire: tapez SNAPANG et donnez les deux points d'extrémité d'un coté, puis basculez en mode ORTHO. Dans ces conditions vous pourrez étirez votre rectangle sans déformation des angles droits.

Même remarque qu'Olivier dans mon code, substitue (à la ligne 25) ((and -> ((or Et au cas ou, tu ne voudrais pas tester les Z, il faudrait changer les lignes: '(-4 . ">=,>=,>=") -> '(-4 . ">=,>=") et '(-4 . "<=,<=,<=") -> '(-4 . "<=,<=")

Très rapidement, je testerais un truc du genre... (defun c:test ( / js ss dfzz n ent pt_start pt_end) (while (null (setq js (ssget (list '(0 . "LINE,ARC,*POLYLINE") '(-4 . "<NOT") '(-4 . "&") '(70 . 112) '(-4 . "NOT>") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) ) ) (setq ss (ssadd)) (if (not dfzz) (setq dfzz 1E-02)) (repeat (setq n (sslength js)) (setq ent (ssname js (setq n (1- n))) pt_start (vlax-curve-getStartPoint ent) pt_end (vlax-curve-getEndPoint ent) ) (cond ((and (ssget "_X" (list '(0 . "POINT,INSERT") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) '(-4 . "<AND") '(-4 . ">=,>=,>=") (cons 10 (mapcar '- pt_start (list dfzz dfzz dfzz))) '(-4 . "<=,<=,<=") (cons 10 (mapcar '+ pt_start (list dfzz dfzz dfzz))) '(-4 . "AND>") ) ) (ssget "_X" (list '(0 . "POINT,INSERT") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) '(-4 . "<AND") '(-4 . ">=,>=,>=") (cons 10 (mapcar '- pt_end (list dfzz dfzz dfzz))) '(-4 . "<=,<=,<=") (cons 10 (mapcar '+ pt_end (list dfzz dfzz dfzz))) '(-4 . "AND>") ) ) ) (ssadd ent ss) ) ) ) (if ss (sssetfirst nil ss)) (prin1) )

@lecrabe Merci Patrice, mais Alexender m'avait fait encore des remarques sur ma routine. Notamment sur les calques verrouillés et sur les Xdata utilisés par des applications internes d'Autocad qu'il convenait de ne pas supprimer. Donc la dernière version que je lui avait adressé ;; ListBox (gile) ;; Boite de dialogue permettant un ou plusieurs choix dans une liste ;; ;; Arguments ;; title : le titre de la boite de dialogue (chaîne) ;; msg ; message (chaîne), "" ou nil pour aucun ;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...) ;; flag : 0 = liste déroulante ;; 1 = liste choix unique ;; 2 = liste choix multipes ;; ;; Retour : la clé de l'option (flag = 0 ou 1) ou la liste des clés des options (flag = 2) ;; ;; Exemple d'utilisation ;; (listbox "Présentation" "Choisir une présentation" (mapcar 'cons (layoutlist) (layoutlist)) 1) (vl-load-com) (defun str2lst (str sep / pos) (if (setq pos (vl-string-search sep str)) (cons (substr str 1 pos) (str2lst (substr str (+ (strlen sep) pos 1)) sep) ) (list str) ) ) (defun ListBox (title msg keylab flag / tmp file dcl_id choice) (setq tmp (vl-filename-mktemp "tmp.dcl") file (open tmp "w") ) (write-line (strcat "ListBox:dialog{label=\"" title "\";") file ) (if (and msg (/= msg "")) (write-line (strcat ":text{label=\"" msg "\";}") file) ) (write-line (cond ((= 0 flag) "spacer;:popup_list{key=\"lst\";") ((= 1 flag) "spacer;:list_box{key=\"lst\";width=32;") (T "spacer;:list_box{key=\"lst\";width=32;multiple_select=true;") ) file ) (write-line "}ok_cancel_err;}" file) (close file) (setq dcl_id (load_dialog tmp)) (if (not (new_dialog "ListBox" dcl_id)) (exit) ) (start_list "lst") (mapcar 'add_list (mapcar 'cdr keylab)) (end_list) (action_tile "accept" "(or (= (get_tile \"lst\") \"\") (if (= 2 flag) (progn (foreach n (str2lst (get_tile \"lst\") \" \") (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice)) ) (setq choice (reverse choice)) ) (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab))) ) ) (done_dialog)" ) (start_dialog) (unload_dialog dcl_id) (vl-file-delete tmp) choice ) (defun c:remove_Xdata ( / AcDoc lay_obj lay_lock js flag n ent_name dxf_ent apps lst_apps lstlk_apps sel_app count) (setq lay_obj (vla-get-layers (setq AcDoc (vla-get-activedocument (vlax-get-acad-object))))) (vla-startundomark AcDoc) (vlax-for for-item lay_obj (if (eq (vla-get-lock for-item) :vlax-true) (setq lay_lock (cons (vla-get-name for-item) lay_lock)) ) ) (if (null (setq js (ssget "_I" '((-3 ("*")))))) (progn (princ "\nSélectionner des objets <Tout>:") (if (null (setq js (ssget '((-3 ("*")))))) (setq js (ssget "_X" '((-3 ("*")))) flag T)) ) ) (cond (js (repeat (setq n (sslength js)) (setq ent_name (ssname js (setq n (1- n))) dxf_ent (entget ent_name (list "*")) apps (cdr (assoc -3 dxf_ent)) ) (if (not (member (cdr (assoc 8 dxf_ent)) lay_lock)) (foreach el apps (if (not (member (car el) lst_apps)) (setq lst_apps (cons (car el) lst_apps))) ) (foreach el apps (if (not (member (car el) lstlk_apps)) (setq lstlk_apps (cons (car el) lstlk_apps))) ) ) ) (setq lst_apps (vl-sort lst_apps '<)) (foreach el '("ACAD" "ACAD_DSTYLE_DIM*" "GradientColor#ACI" "PE_URL" "IRD" "VIA_WD_*" "ACE_TABLE_*" "CIM_WD_*" "AVE_*") (mapcar '(lambda (x) (if (wcmatch x el) (setq lst_apps (vl-remove x lst_apps)))) lst_apps) ) (if lst_apps (setq sel_app (listbox "Applications" "Choisir l'application" (mapcar 'cons lst_apps lst_apps) 2)) (setq lst_apps nil) ) (cond (sel_app (setq js (ssadd) js (ssget "_P" (list (list -3 (list (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) sel_app))))))) (initget "Oui Non _Yes No") (cond ((and js (eq (getkword "\nEtes vous sur de vouloir supprimer les applications sélectionnées [Oui/Non]? <Non>: ") "Yes")) (if (not flag) (if (eq (sslength js) (sslength (ssget "_X" (list (list -3 (list (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) sel_app)))))))) (setq flag T)) ) (setq count 0) (sssetfirst nil js) (repeat (setq n (sslength js)) (setq ent_name (ssname js (setq n (1- n))) dxf_ent (entget ent_name '("*")) ) (if (not (member (cdr (assoc 8 dxf_ent)) lay_lock)) (progn (setq count (1+ count)) (foreach el sel_app (entmod (list (cons -1 ent_name) (list -3 (list el)))) ) ) ) ) (if flag (foreach el sel_app (if (not (member el lstlk_apps)) (vla-delete (vla-item (vla-get-registeredapplications AcDoc) el)) ) ) ) (princ (strcat "\nLes applications " (apply 'strcat (mapcar '(lambda (x) (strcat x ",")) sel_app)) " ont été supprimées pour " (itoa count) " objets" (if flag " et purgées du dessin si l'application n'était pas sur un calque verrouillé." "."))) ) (T (princ "\nPas d'applications corespondantes trouvées pour la sélection")) ) ) (T (princ "\nAucune application sélectionnée ou il y a des applications réservées ou/et des objets sur un calque verrouillé.")) ) ) (T (princ "\nAucune application trouvée dans la sélection.")) ) (vla-endundomark AcDoc) (prin1) )

Ayant eu besoin de revenir sur ce thème, j'ai retravaillé une routine pour faire des cotation de niveaux. Celle ci fonctionne avec deux blocs: un servant de référence et l'autre pour la cotation. Fournir le point de référence Fournir un angle pour le bloc Fournir une échelle d'insertion globale pour le bloc Fournir un facteur de conversion pour la mesure effectuée (par exemple si le dessin est en centimètre, un facteur de 0,01 donnera la mesure en mètres) Et un suffixe facultatif (comme dans l'exemple ci-dessus, on peut mettre 'm' pour corréler.) Ensuite, nous fournissons autant de points à évaluer que nous le souhaitons. Peut normalement fonctionner dans n'importe quel SCU. Si vous souhaitez compléter une cote de niveau sur un point de référence déjà réalisée, choisissez simplement l'option [Sélection] lors de la demande du niveau de référence et choisissez la cote de référence "0.00" pour paramétrer la cote liée à cette référence (Il peut y avoir plusieurs niveaux de référence dans le dessin ) Celui-ci récupère l'angle du bloc, l'échelle du bloc, le SCU du bloc mais pas le facteur de conversion ni le suffixe : ce qui permet de faire par exemple des dimensions en centimètres et en mètres à partir d'un même point de référence. Si le calage du point de référence ou un point coté n'est pas bien bien placé, pas besoin de l'effacer et recommencer, déplacer simplement ceux-ci et faites un REGEN pour mettre à jour les champs. level_pt.lsp

Pour expliquer la paire pointée, du moins ce que j'en ai compris Une paire pointée est toujours constitué d'un atom comme 1er élément et elle sera toujours de 1er niveau (pas d'élément imbriqué, tu ne peux pas faire une paire pointée avec 2 listes.) Comme l'a souligné gilles elle sert dans le dxf à définir la clé dans le 1er élément (car) et la définition dans le second (cdr): (car) et (cdr) étant vraiment la base de la gestion des listes pointée ou non en lisp, donc difficile de faire plus simple et plus rapide pour l’accès aux données...

Mais pourquoi je suis passé à côté de ça ?...😂 dans une paire d'années pointée 🤣

Si je te le présente comme ceci? (cdr (nth (vl-position "Encore" (mapcar 'car lst) ) lst ) ) Après tu décompose par ordre de profondeur: (mapcar 'car lst) -> ("Plus" "Encore" "Pouette") ; retourne la liste lst avec seulement le 1er élément. puis (vl-position "Encore" (mapcar 'car lst)) -> 1 ce qui revient à (vl-position "Encore" '("Plus" "Encore" "Pouette")) ; retourne la position de "Encore" dans la liste soumise (rappel l'index 0 est le premier élément) puis (nth (vl-position "Encore" (mapcar 'car lst)) lst) -> ("Encore" . 74) ce qui revient à (nth 1 lst) ; retourne le deuxième élément de la liste lst et enfin (cdr (nth (vl-position "Encore" (mapcar 'car lst)) lst)) -> 74 ce qui revient à (cdr '("Encore" . 74)) ; retourne le 2ème élément de la paire pointée, soit la clé recherchée. NB: A la différence d'une liste normale où le (cadr) serait employé pour avoir le second élémenent. Comprendo?

exemple: (setq Lst (list (cons "Pouette" 73)) Lst (cons (cons "Encore" 74) Lst) Lst (cons (cons "Plus" 12) Lst) ) (cdr (nth (vl-position "Encore" (mapcar 'car lst)) lst))

Je t'ai donné un lien en MP

Bonjour, J'ai ouvert ton fichier (en ignorant le message de le récupérer) et effectivement il y a des erreurs. Je n'ai pas corrigé les erreurs avec CONTROLE Ma méthode pour identifier les objets avec le handle n'a pas fonctionné. Par contre avec la sélection rapide de la palette des propriétés ( _.QSELECT), je me suis aperçu qu'il y avait des entité proxy. J'ai choisi de les sélectionner par calque /= "0" et je les ais effacés. J'ai enregistré sous un nouveau nom, fermé ton dessin, ouvert ce nouveau dessin et PAS D'ERREURS et le bloc semblant poser problème s'insère parfaitement. J'en déduit que c'est ces entités proxy qui posaient problème. Si toi aussi tu n'as pas utilité de ces entités PROXY et que tu ne peux pas les voir, efface les! Ces entités proviennent certainement d'un produit vertical comme Autocad Architecture, je crois qu'il y a un plugin à installer pour un Autocad classique pour pouvoir les voir, mais là il faudrait l'avis d'un utilisateur d'architecture pour confirmé mes dires. Ces entités proxy sont pour moi une plaie. (mais ce n'est que mon avis)

Aux vues de tes images, il y a des problème sur des polylignes, des calques et des blocs. NB: les identifiants/handle retourné par Contrôle sont entre parenthèses ex: (D391C) que tu pourrais traduire par "D391C" Mais mon exemple demande une bonne (très bonne) connaissance des code DXF (qu'il faudrait adapter à chaque entités concernées) Personnellement j'ai déjà corrigé des fichiers que j'avais construit de A à Z (dont j'avais une parfaite connaissance) par ces manipulations: je savais quoi corriger! _Audit (avec corrections) est la solution la plus simple, mais tu vas te traîner par exemple un calque $AUDIT-BAD-LAYER que tu ne pourras te débarrasser facilement. Sans avoir le fichier, difficile de t'orienter plus que cela (C'est même pas sur que moi même j'y arrive, j'ai du mal quand cela peut concerner des réacteurs ou des dictionnaires) Je pense que tu vas devoir faire avec un fichier pourri, à moins que tu reparte d'un fichier "clean" sauvé quelque part ou d'un "BAK"... Le problème te semble récent? (en ce cas le BAK serait la solution la plus simple, sans trop perdre de boulot!) Autrement il va falloir faire avec !... Après si c'est pas confidentiel, transmettre le fichier, voir si je peux résoudre le problème!

Bonjour, Alors sans pouvoir réellement tester... Faire la commande CONTROLE (_AUDIT) sans corrections. Relever dans les informations retournées le HANDLE de/des entités concernés. (exemple "2C0") puis en ligne de commande coller ceci: REMPLACER "2C0" par le handle que vous avez obtenu. (command "_.-bedit" (cdr (assoc 2 (entget (handent "2C0"))))) Normalement cela devrait ouvrir l'éditeur de bloc avec le bloc concerné. Essayez de corriger ce qui est anormal et sauvegardez votre nouvelle définition pour mettre à jour votre table des blocs.

@Mfruncad Merci pour le fichier exemple. Après de mineures modifications, mon code (que j'ai mis à jour dans mon post précédent) semble fonctionner. NB: Si tu veux supprimer l'entité originale dé-commente (enlever le point virgule) à la ligne 78 ;(vla-Delete vla_obj)

Bonjour, Un peu similaire a Fraid. Un dessin exemple aurait été utile pour tester le code, il est possible qu'il ne fonctionne pas. (vl-load-com) (defun c:test ( / ss_pl AcDoc Space n ent vla_obj dxf_ent prm lst_pt pt ss_blk obj lst_att val nw_pl) (princ "\nSélectionner les polylignes") (setq ss_pl (ssget (list (cons 0 "*POLYLINE") (cons 67 (if (eq (getvar "CVPORT") 2) 0 1)) (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB"))) (cons -4 "<NOT") (cons -4 "&") (cons 70 126) (cons -4 "NOT>") ) ) ) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (eq (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (cond (ss_pl (repeat (setq n (sslength ss_pl)) (setq ent (ssname ss_pl (setq n (1- n))) vla_obj (vlax-ename->vla-object ent) dxf_ent (entget ent) prm -1 lst_pt nil ) (repeat (if (zerop (boole 1 0 (cdr (assoc 70 dxf_ent)))) (1+ (fix (vlax-curve-getEndParam ent))) (fix (vlax-curve-getEndParam ent)) ) (setq pt (vlax-curve-GetPointAtParam ent (setq prm (1+ prm))) ss_blk (ssget "_X" (list '(0 . "INSERT") '(2 . "IC_11_*") '(-4 . "<AND") '(-4 . ">=,>=,*") (cons 10 pt) '(-4 . "<=,<=,*") (cons 10 pt) '(-4 . "AND>") ) ) val (cond ((and ss_blk (eq (sslength ss_blk) 1)) (setq obj (vlax-ename->vla-object (ssname ss_blk 0)) lst_att (mapcar '(lambda (x) (cons (vla-get-TagString x) (vla-get-TextString x))) (vlax-invoke Obj 'GetAttributes) ) val (atof (cdr (assoc "Altitude_GS" lst_att))) lst_pt (cons (list (car pt) (cadr pt) val) lst_pt) ) ) ) ) ) (if (> (length lst_pt) 1) (progn (setq nw_pl (vlax-invoke Space 'Add3DPoly (apply 'append lst_pt))) (vla-put-Layer nw_pl (vla-get-Layer vla_obj)) (vla-put-Closed nw_pl (vla-get-Closed vla_obj)) (vla-put-Color nw_pl (vla-get-Color vla_obj)) (vla-put-Linetype nw_pl (vla-get-Linetype vla_obj)) (vla-put-LinetypeScale nw_pl (vla-get-LinetypeScale vla_obj)) (vla-Update nw_pl) ;(vla-Delete vla_obj) ) ) ) ) ) (prin1) )

A essayer... Cela semble pouvoir faire le job! transfert_OD.lsp