-
Compteur de contenus
5 029 -
Inscription
-
Dernière visite
-
Jours gagnés
56
Type de contenu
Profils
Forums
Calendrier
Blogs
Tout ce qui a été posté par bonuscad
-
(wcmatch ... ) et les caractères spéciaux
bonuscad a répondu à un(e) sujet de Déméter_33 dans Routines LISP
Rien ne me choque dans ta syntaxe qui puisse expliquer ton résultat, sauf si tes variables ne sont pas déclaré en locale, ce qui pourrait expliquer ce retour mais sans voir l'intégralité du code difficile de trouver la cause... Cependant tu pourrait essayer de tourner ta déclaration comme ceci ((lambda ( / Ouv Leg) (initget 128 "µ") (setq Ouv (getreal "\nDonner l'ouverture du faïençage en mm? <µ>: ")) (if (not Ouv) (setq Ouv "µ")) (if (eq Ouv "µ") (print (setq Leg "F:µ")) (print(setq Leg (strcat "F: " (rtos Ouv 2 2) "mm"))) ) (prin1) )) -
Bonjour, Bien que (grread) ne permet pas l'accroche aux objets, on peut l'émuler pour certain mode; "extrémité" "milieu" "centre" "nodal" "quadrant" "intersection" "insertion" "perpendiculaire" "tangent" "proche" si l'accroche objet est actif. Cela complexifie un peu le code est n'est pas aussi performant que le véritable accroche objet mais ça fonctionne. Les autres demandes sont simple à modifier. Le lisp modifié: Dim-Grid_fr.lsp
-
Soit tu peux faire le manuellement dans l'éditeur de bloc et rendre la définition d'attribut invisible puis utiliser ATTSYNC dans le dessin Soit réutiliser le code où j'ai rendu l'attribut invisible (j'ai simplement passé le code dxf 70 de 0 à 1 pour la définition d'attribut et l'attribut lors de l'insertion) pour que ce soit effectif dans d'autres dessins n'ayant pas encore ce bloc PCENTRE. rac_circuit_panneaux.lsp
-
@sofianerm Essaye le fichier joint rac_circuit_panneaux.lsp
-
@sofianerm Tes blocs n'ont que deux attributs, donc si l’étiquette et POINT1 alors je stocke le point d'insertion dans la liste des points de départ autrement par défaut sera forcément le POINT2 donc l'insertion sera stocké dans la liste des points finaux: listes l_start et l_end
-
Tu peux essayer sous cette forme: oblige une sélection dans l'ordre UNE à UNE... (defun c:test ( / sel ent dxf_ent n_ent l_start l_end) (while (setq sel (entsel "\nSélectionner les blocs CLAM dans l'ordre UN à UN: ")) (cond (sel (setq ent (car sel) dxf_ent (entget ent) ) (cond ((and (eq (cdr (assoc 0 dxf_ent)) "INSERT") (eq (cdr (assoc 8 dxf_ent)) "CAESAR-Bac-Platte") (equal (assoc 66 dxf_ent) '(66 . 1)) (wcmatch (cdr (assoc 2 dxf_ent)) "CLAM-2#00") ) (setq n_ent ent) (while (/= (cdr (assoc 0 (setq dxf_ent (entget (setq n_ent (entnext n_ent)))))) "SEQEND") (if (eq (cdr (assoc 2 dxf_ent)) "POINT1") (setq l_start (cons (cdr (assoc 10 dxf_ent)) l_start)) (setq l_end (cons (cdr (assoc 10 dxf_ent)) l_end)) ) ) ) (T (princ "\nN'est pas un bloc CLAM!")) ) ) ) ) (cond ((and l_start l_end) (mapcar '(lambda (x y) (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(67 . 0) '(410 . "Model") '(8 . "_CAESAR Flexible") '(100 . "AcDbPolyline") '(90 . 2) '(70 . 0) '(43 . 0.0) '(38 . 0.0) '(39 . 0.0) (cons 10 x) '(40 . 0.0) '(41 . 0.0) (cons 42 (if (< (cadr y) (cadr x)) 0.5 -0.5)) '(91 . 0) (cons 10 y) '(40 . 0.0) '(41 . 0.0) '(42 . 0.0) '(91 . 0) '(210 0.0 0.0 1.0) ) ) ) (cdr (reverse l_start)) (vl-remove (last (reverse l_end)) (reverse l_end)) ) ) ) (prin1) )
-
NB: Enlever le "_X" à la fonction (ssget) si tu veux pouvoir sélectionner les blocs manuellement et non pas toutes les insertions du dessin
-
Bonjour, Essaye ceci ! (defun c:test ( / ss n ent n_ent dxf_ent l_start l_end) (setq ss (ssget "_X" '((0 . "INSERT") (8 . "CAESAR-Bac-Platte") (66 . 1) (2 . "CLAM-2#00")))) (cond (ss (repeat (setq n (sslength ss)) (setq ent (ssname ss (setq n (1- n))) n_ent ent ) (while (/= (cdr (assoc 0 (setq dxf_ent (entget (setq n_ent (entnext n_ent)))))) "SEQEND") (if (eq (cdr (assoc 2 dxf_ent)) "POINT1") (setq l_start (cons (cdr (assoc 10 dxf_ent)) l_start)) (setq l_end (cons (cdr (assoc 10 dxf_ent)) l_end)) ) ) ) (setq l_start (vl-sort (mapcar '(lambda (x) (list (car x) (cadr x))) l_start) '(lambda (e1 e2) (> (cadr e1) (cadr e2)))) l_end (vl-sort (mapcar '(lambda (x) (list (car x) (cadr x))) l_end) '(lambda (e1 e2) (> (cadr e1) (cadr e2)))) ) (mapcar '(lambda (x y) (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(67 . 0) '(410 . "Model") '(8 . "_CAESAR Flexible") '(100 . "AcDbPolyline") '(90 . 2) '(70 . 0) '(43 . 0.0) '(38 . 0.0) '(39 . 0.0) (cons 10 x) '(40 . 0.0) '(41 . 0.0) (cons 42 -0.5) '(91 . 0) (cons 10 y) '(40 . 0.0) '(41 . 0.0) '(42 . 0.0) '(91 . 0) '(210 0.0 0.0 1.0) ) ) ) (cdr l_start) (vl-remove (last l_end) l_end) ) ) ) (prin1) )
-
Ligne de repère multiple avec champ
bonuscad a répondu à un(e) sujet de ChatGris dans AutoCAD 2020-2024
Pour moi le point est la seule solution... J'ai automatisé la chose pour faire des insertions multiples sans multiplier les actions. Tu peux ainsi obtenir les coordonnées des points de définitions de différents type d'objets ("LINE,MLINE,*POLYLINE,POINT,ARC,CIRCLE,ELLIPSE,INSERT") avec des LRM en une seule action par un filtre simple (calque, espace, type de ligne, couleur + éventuellement fermé/ouvert pour les polylignes) réalisé par la sélection d'une entité modèle. La routine place les points dans un calque spécifique: Id-point que tu peux geler/inactivé (même pendant l'utilisation ultérieure de la commande si ceux-ci te gênent. Si des placement de quelques LRM (en cas de l'utilisation de l'option Multiple) ne conviennent pas, il est facile avec les poignées de l'étirer à un autre endroit. Seul point négatif: Si toutes fois du modifie la géométrie par les grips de l'entité source pense à modifier aussi le point qui lui est associé pour que le champ se mette à jour... Le code si cela peut t’intéresser.... ptdef-xy_field2lead.lsp -
boite de dialogue, selectionner plusieurs fichiers dwg
bonuscad a répondu à un(e) sujet de PHILPHIL dans Pour aller plus loin en LISP
On pourrait utiliser (ListBox) de (gile). A affiner si cela ne convient pas ; str2lst ;; Transforme un chaine avec séparateur en liste de chaines ;; ;; Arguments ;; str : la chaine à transformer en liste ;; sep : le séparateur ;; ;; Exemples ;; (str2lst "a b c" " ") -> ("a" "b" "c") ;; (str2lst "1,2,3" ",") -> ("1" "2" "3") (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) ) ) ;; 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) (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\";") (T "spacer;:list_box{key=\"lst\";multiple_select=true;") ) file ) (write-line "}spacer;ok_cancel;}" 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 ) (vl-load-com) (defun c:my_insert ( / ShlObj Folder FldObj Out_Fld lst_dwg) (setq ShlObj (vla-getinterfaceobject (vlax-get-acad-object) "Shell.Application") Folder (vlax-invoke-method ShlObj 'BrowseForFolder 0 "" 0) ) (vlax-release-object ShlObj) (if Folder (progn (setq FldObj (vlax-get-property Folder 'Self) Out_Fld (vlax-get-property FldObj 'Path) ) (vlax-release-object Folder) (vlax-release-object FldObj) ) ) (foreach dwg (vl-directory-files Out_Fld "*.dwg" 1) (setq lst_dwg (cons dwg lst_dwg)) ) (setq lst_dwg (listbox "Dessins dans le dossier" "Choisir un/des dessin" (mapcar 'cons lst_dwg lst_dwg) 2)) (setvar "CMDECHO" 0) (command "_.ucs" "_world") (foreach dwg lst_dwg (command "_.-insert" (strcat Out_Fld "\\" dwg) "_none" '(0.0 0.0 0.0) 1.0 1.0 0.0) ) (command "_.ucs" "_previous") (setvar "CMDECHO" 1) (prin1) ) -
resolu ! commande polyligne avec largeur globale
bonuscad a répondu à un(e) sujet de Zaher_chn dans AutoCAD 2020-2024
@Zaher_chn Bonjour, Une autre méthode possible avec juste une sélection. Pour cela il faudrait que tu décompose le bloc qui représente tes contours de mur et appliquer le code suivant. Avec ton dessin de test, ça à l'air de fonctionner. (defun c:zaher ( / ss modelSpace e_first p_s p_e n e pt_s pt_e off prm pt lst_pt nw_pl) (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 1) (-4 . "NOT>")))) (cond (ss (setq modelSpace (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))) (while (> (sslength ss) 0) (setq e_first (ssname ss 0) p_s (vlax-curve-getStartPoint e_first) p_e (vlax-curve-getEndPoint e_first) ) (ssdel e_first ss) (repeat (setq n (sslength ss)) (setq e (ssname ss (setq n (1- n))) pt_s (vlax-curve-getStartPoint e) pt_e (vlax-curve-getEndPoint e) ) (cond ((member (setq off (distance p_s pt_s)) '(15.0 18.0 20.0)) (setq prm -1) (repeat (1+ (fix (vlax-curve-getEndParam e_first))) (setq pt (mapcar '* (mapcar '+ (vlax-curve-getPointAtParam e_first (setq prm (1+ prm))) (vlax-curve-getPointAtParam e prm) ) '(0.5 0.5 0.5) ) lst_pt (cons (list (car pt) (cadr pt)) lst_pt) ) ) (setq nw_pl (vlax-invoke modelSpace 'AddLightWeightPolyline (apply 'append lst_pt))) (vlax-put nw_pl 'ConstantWidth off) (cond ((eq off 20.0) (vlax-put nw_pl 'Layer "_MTH_Voile extérieur ht 2.80m_280")) ((or (eq off 15.0) (eq off 18.0)) (vlax-put nw_pl 'Layer "_MTH_Voile intérieur ht 2.60m_260")) ) (ssdel e ss) (setq lst_pt nil) ) ) ) ) ) ) (prin1) ) -
resolu ! Lisp Sommaire ne fonctionne pas au delà de 20 onglets de présentation
bonuscad a répondu à un(e) sujet de Dominique974 dans Débuter en LISP
Pour faire plus simple (surtout que le lisp proposé par Patrick_35 utilisait déjà les fonction (vla-), serait de remplacer: (entmake (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 410 "01") (cons 10 '(20.0000 133.5000 0.0)) (cons 40 3.5) (cons 1 txt) ) ) par cette ligne: (vla-AddMText (vla-get-ModelSpace doc) (vlax-3d-point 20.0 133.5 0.0) 3.5 txt) car dans ce cas la fonction (vla-AddMText) s'occupe de gérer les blocs par 250 caractères en créant les blocs (3 . "xxxxxx") nécessaires. Je n'ai pas testé, mais cela devrait fonctionner, par contre je ne sais pas dans quel espace cela doit être écrit (dans la ligne donnée c'est dans l'espace Objet) -
resolu ! Lisp Sommaire ne fonctionne pas au delà de 20 onglets de présentation
bonuscad a répondu à un(e) sujet de Dominique974 dans Débuter en LISP
Bonjour, Je pense que le problème vient du (entmake) concernant le MTEXT au niveau du (cons 1 txt) En effet si la variable txt contient une chaîne supérieur à 250 caractères, la chaîne doit être divisée par bloc de 250 caractères qui seront placé dans liste avec la clé 3 (autant de foi que nécessaire) Voir l'aide DXF sur le MTEXT -
Disparition d'éléments dans la feuille objet
bonuscad a répondu à un(e) sujet de Coline dans AutoCAD 2020-2024
Bonjour, Tout d'abords un contrôle du dessin est nécessaire Puis si dans l'espace Objet (Model), tu fais un zoom étendu tu retrouveras ton dessin que tu peux voir dans tes fenêtres de l'espace papier. (layout) Ce qui me fais penser qu'il y a eu une insertion d'objets dont l'origine n'était pas à la même échelle car ce que l'on voit à l'ouverture de ton dessin dans l'espace objet apparaît en tout petit au coin bas gauche après le zoom étendu. Une mise à l'échelle de l'un ou l'autre me parait nécessaire, mais ne sachant exactement ce que tu veux obtenir, difficile de t'orienter plus. -
SVP Routine Lisp depuis OD pour changer la Rotation d un Bloc
bonuscad a répondu à un(e) sujet de lecrabe dans Autodesk Map
@lecrabe Si tu rajoutes entre la ligne 112-113 : avant (entmod ....), cette ligne: (setq str (+ (angtof (rtos str 2 16) (getvar "AUNITS")) (cdr (assoc 50 dxf_ent)))) Cela semble faire l'affaire... -
SVP Routine Lisp depuis OD pour changer la Rotation d un Bloc
bonuscad a répondu à un(e) sujet de lecrabe dans Autodesk Map
Salut, En partant du OD2DXF38 et en l'adaptant, cela ferait-il l'affaire? (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\";") (T "spacer;:list_box{key=\"lst\";multiple_select=true;") ) file ) (write-line "}spacer;ok_cancel;}" 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:OD2DXF50 ( / js obj dxf_ent ename lst_tabl_def inc_key lst_def desc_od desc_tbl str) (princ "\nSélectionnez les insertions de blocs.") (while (null (setq js (ssget (list '(0 . "INSERT") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) ) (princ "\nCe n'est pas un objet valable pour cette fonction!") ) (repeat (setq n (sslength js)) (setq obj (ssname js (setq n (1- n))) dxf_ent (entget obj) ename (vlax-ename->vla-object obj) ) (cond ((ade_odgettables obj) (setq lst_tabl_def (mapcar 'ade_odtabledefn (ade_odgettables obj)) inc_key 0) (foreach n lst_tabl_def (foreach el n (if (listp (cdr el)) (foreach sel (cdr el) (foreach msel sel (if (eq (car msel) "ColName") (setq lst_def (cons (cons (strcat "key" (itoa (setq inc_key (1+ inc_key)))) (cdr msel)) lst_def)) ) ) ) ) ) ) (if (not desc_od) (setq desc_od (cdr (assoc (listbox "Donnée d'objet" "Choisir une données d'objet" lst_def 1) lst_def)) desc_tbl nil) ) (foreach n lst_tabl_def (if (assoc (cons "ColName" desc_od) (cdaddr n)) (setq desc_tbl (cdar n)) ) ) (cond (desc_tbl (setq str (ade_odgetfield obj desc_tbl desc_od 0)) (cond ((eq (type str) 'STR) (setq str (atof str))) ((eq (type str) 'INT) (setq str (float str))) ) (entmod (subst (cons 50 str) (assoc 50 dxf_ent) dxf_ent)) ) ) ) (T (princ "\nPas de données d'objet attachées")) ) ) (prin1) ) -
Pour ma part, je remarque que si pour une cotation je grip le texte pour le déplacer (même légèrement), le texte se retrouve avec les positions grisées dans la palette des propriétés. Aurais tu fais la même action sur ta cotation?
-
Ça me rappelle ce sujet que j'avais lancé. Depuis ce logiciel open source Meshroom produit par AliceVision a peut être encore évolué? Mais semble toujours aussi "coton" à utiliser... Il y a, je vois, des plugins pour Blender et Maya (encore des logiciels qui demande de les maîtriser: donc du temps d'apprentissage)
-
convertir MTXT en bloc avec attribut
bonuscad a répondu à un(e) sujet de philsogood dans AutoCAD 2020-2024
Comme le dit JPhil voici le code ressemblant adapté à ton dessin exemple ((lambda ( / js n dxf_ent pt txt) (if (not (tblsearch "STYLE" "ROMANS")) (entmake '( (0 . "STYLE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "ROMANS") (70 . 0) (40 . 0.0) (41 . 0.8) (50 . 0.0) (71 . 0) (42 . 0.0945) (3 . "romans.shx") (4 . "") ) ) ) (if (not (tblsearch "BLOCK" "MTX2BLK")) (progn (entmake '( (0 . "BLOCK") (100 . "AcDbEntity") (8 . "0") (2 . "MTX2BLK") (70 . 2) (4 . "") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (10 0.0 0.0 0.0) ) ) (entmake '( (0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbText") (10 -0.2034 -0.04725 0.0) (40 . 0.0945) (1 . "") (50 . 0.0) (41 . 0.8) (51 . 0.0) (7 . "ROMANS") (71 . 0) (72 . 1) (11 0.0 0.0 0.0) (210 0.0 0.0 1.0) (100 . "AcDbAttributeDefinition") (280 . 0) (3 . "Texte vers Attribut") (2 . "VALEUR") (70 . 0) (73 . 0) (74 . 2) (280 . 1) ) ) (entmake '( (0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbPolyline") (90 . 4) (70 . 1) (43 . 0.0) (38 . 0.0) (39 . 0.0) (10 -0.61349 0.100763) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 -0.61349 -0.100763) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 0.624823 -0.100763) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (10 0.624823 0.100763) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0) (210 0.0 0.0 1.0) ) ) (entmake '((0 . "ENDBLK") (100 . "AcDbEntity") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2))) ) ) (setq js (ssget "_X" '((0 . "MTEXT") (67 . 0) (410 . "Model") (8 . "Repere")))) (cond (js (repeat (setq n (sslength js)) (setq ent (ssname js (setq n (1- n))) dxf_ent (entget ent) pt (cdr (assoc 10 dxf_ent)) txt (cdr (assoc 1 dxf_ent)) ) (entmake (list '(0 . "INSERT") '(100 . "AcDbEntity") '(67 . 0) '(410 . "Model") '(8 . "Repere") '(100 . "AcDbBlockReference") '(66 . 1) (cons 2 "MTX2BLK") (cons 10 pt) '(41 . 1.0) '(42 . 1.0) '(43 . 1.0) '(50 . 0.0) '(70 . 0) '(71 . 0) '(44 . 0.0) '(45 . 0.0) '(210 0.0 0.0 1.0) ) ) (entmake (list '(0 . "ATTRIB") '(100 . "AcDbEntity") '(67 . 0) '(410 . "Model") '(8 . "0") '(62 . 0) '(6 . "ByBlock") '(370 . -2) '(100 . "AcDbText") (cons 10 pt) '(40 . 0.0945) (cons 1 txt) '(50 . 0.0) '(41 . 1.0) '(51 . 0.0) '(7 . "ROMANS") '(71 . 0) '(72 . 1) (cons 11 pt) '(210 0.0 0.0 1.0) '(100 . "AcDbAttribute") '(280 . 0) '(2 . "VALEUR") '(70 . 0) '(73 . 0) '(74 . 2) '(280 . 1) ) ) (entmake (list '(0 . "SEQEND") '(100 . "AcDbEntity") '(67 . 0) '(410 . "Model") '(8 . "Repere"))) (entdel ent) ) ) ) (prin1) )) -
Remplacer un texte par un attribut en récupérant la valeur du texte
bonuscad a répondu à un(e) sujet de nen dans Débuter en LISP
Bonjour, A copier-coller directement en ligne de commande. ((lambda ( / js n dxf_ent pt txt) (setq js (ssget '((0 . "TEXT") (62 . 2)))) (cond (js (repeat (setq n (sslength js)) (setq dxf_ent (entget (ssname js (setq n (1- n)))) pt (cdr (assoc 10 dxf_ent)) txt (cdr (assoc 1 dxf_ent)) ) (entmake (list '(0 . "INSERT") '(100 . "AcDbEntity") '(67 . 0) '(410 . "Model") (cons 8 (getvar "CLAYER")) '(62 . 4) '(100 . "AcDbBlockReference") '(66 . 1) (cons 2 "Attribut") (cons 10 pt) '(41 . 1.0) '(42 . 1.0) '(43 . 1.0) '(50 . 0.0) '(70 . 0) '(71 . 0) '(44 . 0.0) '(45 . 0.0) '(210 0.0 0.0 1.0) ) ) (entmake (list '(0 . "ATTRIB") '(100 . "AcDbEntity") '(67 . 0) '(410 . "Model") (cons 8 (getvar "CLAYER")) '(62 . 0) '(100 . "AcDbText") (cons 10 pt) '(40 . 8.0) (cons 1 txt) '(50 . 0.0) '(41 . 1.0) '(51 . 0.0) '(7 . "Standard") '(71 . 0) '(72 . 1) (cons 11 pt) '(210 0.0 0.0 1.0) '(100 . "AcDbAttribute") '(280 . 0) '(2 . "NUMERO") '(70 . 0) '(73 . 0) '(74 . 2) '(280 . 1) ) ) (entmake (list '(0 . "SEQEND") '(100 . "AcDbEntity") '(67 . 0) '(410 . "Model") (cons 8 (getvar "CLAYER")) '(62 . 4))) ) ) ) (prin1) )) -
Bonjour, Une astuce qui avait été évoqué par Patrick_35 mais je ne retrouve pas le sujet. Je vais essayer de résumer son propos: Lancer la commande en français en ligne de commande (si nécessaire précéder d'un tiret (-) pour shunter les commande en boite de dialogue) Choisir l'option en Français et la valider. Annuler cette demande par annulation (Echap/Esc) (plusieurs fois si nécessaire) Relancer cette dernière commande par (Entrée/Enter) Et là est l'astuce: avec la flèche haute du clavier rappeler la dernière option qui sera proposée dans sa version Anglaise. Exemple: Cela fonctionne pour la majorité des commandes, mais pas toutes...
-
Récurrences non reconnues (erreur: no function definition: BOUCLE)
bonuscad a répondu à un(e) sujet de Déméter_33 dans Routines LISP
Bonjour, Je te propose une version un peu plus poussée (si j'ai bien compris la boucle que tu voulais faire) Elle emploi les code DXF (il me semble essentiel qu'un lispeur se familiarise avec ces codes), j'ai évité les fonction (vlax- qui sont plus performantes mais encore plus obscur pour un débutant. Ce code s'occupe de créer le calque, le style de texte et le bloc s'ils n'existent pas. Il évite l'emploi de (command "xxx") sauf pour la création de la spline. Après il y a plein de moyen de faire, j'ai poussé un peu mais pas trop (je suis rester en vanilla lisp qui serait compatible avec des clones d'Autocad) (defun c:FISS(/ l_var rep dxf_210 pt_ins dxf_ent tmp O) (if (not (tblsearch "STYLE" "DIADES")) (entmake '( (0 . "STYLE") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "DIADES") (70 . 0) (40 . 2.0) (41 . 1.0) (50 . 0.0) (71 . 0) (42 . 2.0) (3 . "arial.ttf") (4 . "") ) ) ) (if (not (tblsearch "LAYER" "102-PATHO SECHE")) (entmake '( (0 . "LAYER") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "102-PATHO SECHE") (70 . 0) (62 . 1) (6 . "Continuous") (290 . 1) (370 . -3) ) ) ) (if (not (tblsearch "BLOCK" "bar")) (progn (entmake '((0 . "BLOCK") (2 . "bar") (70 . 2) (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (10 0.0 0.0 0.0)) ) (entmake '( (0 . "LINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbLine") (10 -1.451108208811707 0.0 0.0) (11 1.451108208811707 0.0 0.0) (210 0.0 0.0 1.0) ) ) (entmake '((0 . "ENDBLK") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2))) ) ) (setq l_var (mapcar 'getvar '("OSMODE" "AUTOSNAP")) rep "Oui" ) (mapcar 'setvar '("OSMODE" "AUTOSNAP") '(512 55)) (initcommandversion 2) (command "_.spline") (while (not (zerop (getvar "CMDACTIVE"))) (command pause) ) (initcommandversion 1) (setq dxf_210 (assoc 210 (entget (entlast)))) (while (eq rep "Oui") (initget 9) (setq pt_ins (trans (getpoint "\nDonner la position: ") 1 0)) (entmake (list '(0 . "INSERT") '(100 . "AcDbEntity") '(67 . 0) '(410 . "Model") '(8 . "102-PATHO SECHE") '(100 . "AcDbBlockReference") '(2 . "bar") (cons 10 (trans pt_ins 0 (cdr dxf_210))) '(41 . 1.0) '(42 . 1.0) '(43 . 1.0) '(50 . 0.0) '(70 . 0) '(71 . 0) '(44 . 0.0) '(45 . 0.0) dxf_210 ) ) (setq dxf_ent (entget (entlast))) (princ "\nDonner l'angle du bloc: ") (while (= 5 (car (setq tmp (grread t 5 1)))) (entmod (subst (cons 50 (angle pt_ins (trans (cadr tmp) 1 0))) (assoc 50 dxf_ent) dxf_ent)) (entupd (cdar dxf_ent)) ) (initget 1) (setq O (getint "\nDonner la valeur de l'Ouverture O:")) (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") '(67 . 0) '(410 . "Model") (cons 8 (getvar "CLAYER")) '(100 . "AcDbText") (cons 10 (trans pt_ins 0 (cdr dxf_210))) '(40 . 2.0) (cons 1 (strcat "O:" (itoa O) "mm")) '(50 . 0.0) '(41 . 1.0) '(51 . 0.0) '(7 . "DIADES") '(71 . 0) '(72 . 0) '(11 0.0 0.0 0.0) dxf_210 '(100 . "AcDbText") '(73 . 0) ) ) (setq dxf_ent (entget (entlast))) (princ "\nDonner la position du texte: ") (while (= 5 (car (setq tmp (grread t 5 1)))) (entmod (subst (cons 10 (trans (cadr tmp) 1 (cdr dxf_210))) (assoc 10 dxf_ent) dxf_ent)) (entupd (cdar dxf_ent)) ) (initget "Oui Non") (setq rep (getkword "\nContinuer ? [Oui/Non] <Oui>: ")) (if (not (eq rep "Non")) (setq rep "Oui")) ) (mapcar 'setvar '("OSMODE" "AUTOSNAP") l_var) (prin1) ) -
Supprimer des objets en dehors d\'un contours
bonuscad a répondu à un(e) sujet de sada20 dans AutoCAD 2007
@drault Si je ne suis pas hors sujet, tu pourrais essayer CECI. -
ACAD LT 2024 Win : les Lisps/VLisps qui fonctionnent
bonuscad a répondu à un(e) sujet de lecrabe dans AutoCAD LT 2024
@didier Complètement d'accord avec ce sentiment. N'oublions pas qu'AutoDesk développe le noyau d'AutoCAD et que celui-ci sert indifféremment pour la version full que pour la LT: Pour la LT, le noyau et simplement bridé. Rappelez vous l'existence de LT-Extender qui débridait ce noyau et qui ont été pris en défaut juridiquement par AutoDesk pour ce procédé qui enfreignait le Copyrigth. Pour moi les Lisps qui ne font pas appel à des API (ObjectDBX par exemple) fonctionneront aussi bien que sur une version Full. Cette nouveauté n'est à mon avis qu'une opération commerciale (qui ne leur coûte rien en terme de développement, juste le débridage du noyau pour la LT), mais va peut être leur permettre de conserver la position de leader face à l'apparition des clones qui doivent certainement leur prendre une part conséquente du marché. -
résolu Transformer succession d'arc d'une même polyligne en ligne brisée paramétrable
bonuscad a répondu à un(e) sujet de Jaypee dans AutoCAD 2020-2024
Bonjour, Voir cette réponse si elle convient?
