bonuscad

C'est schtroumpfement vrai, je suis un schtroumpf et schtroumpf de l'être. C'est un language que les politiques devraient adopter, on peut tout dire et chacun y comprends ce qui veut. Vive la Schtroumpf! (ou schtroumpfette)

Je ne vois pas trop d'où peut venir le problème... Peut être l'encodage du fichier lors de l'enregistrement dans ton éditeur, pour ma part j'encode en ANSI (ceci pour les caractères accentués), plus rarement en UTF-8 lors d'échange international. Si tu copie-colle directement le code depuis le site en ligne de commande d'autocad, tu as aussi cette erreur?

Merci Eric, je mes suis fais berné par l'icone SCU qui était inactif, je croyais que le dessin était dans le SCG. Là tout redevient compréhensible, je me suis fais avoir comme un bleu

Un truc bizarre que j'ai observé sur l'exemple original.Si l'on déplace tout proche du zéro et que l'on fait un (entget(car(entsel))) sur une polyligne, les coordonnées ont conservées les grandes valeurs????Et le code 210 est bien de 0,0,1 (SCG) Je me demande si une bidouille n'a pas été appliqué sur ce code 210 (utilisation de grand nombre, non perçu à l'affichage)Pour l'instant je n'ai pas le temps de me pencher sur ce problème.

Bonjour, Cela doit être possible avec (getenv) et (setenv). Le problème c'est qu'il y a une "fouletitude" de variables avec des noms à rallonge et qu'il n'y a aucune documentation à ce sujet. Tout est dans le registre windows. Voir cette explication Bon courage ! Par exemple un truc qui ne répond pas à ta demande mais qui montre l'utilisation de (setenv) et (getenv): cela bascule l'affichage en Noir ou Blanc. (defun c:BlackAndWhite ( / disp fonc1 fonc2 togg_bk togg_cr bg_color cr_color) (vl-load-com) (setq disp (vla-get-display (vla-get-preferences (vlax-get-acad-object)))) (if (zerop (getvar "tilemode")) (setq fonc1 '(vla-put-GraphicsWinLayoutBackgrndColor disp bg_color) fonc2 ' (vla-put-LayoutCrosshairColor disp cr_color) togg_bk (getenv "Layout background") togg_cr (getenv "LayoutXhairPickboxEtc") ) (setq fonc1 '(vla-put-GraphicsWinModelBackgrndColor disp bg_color) fonc2 '(vla-put-ModelCrosshairColor disp cr_color) togg_bk (getenv "Background") togg_cr (getenv "XhairPickboxEtc") ) ) (cond ((and (eq togg_bk "0") (eq togg_cr "14079702")) (setq bg_color 16777215 cr_color 2960685) ) ((and (eq togg_bk "16777215") (eq togg_cr "2960685")) (setq bg_color 0 cr_color 14079702) ) (T (initget "Noir Blanc _Black White") (if (eq (getkword "\nCouleur de fond [Noir/Blanc]? <Noir>: ") "White") (setq bg_color 16777215 cr_color 2960685) (setq bg_color 0 cr_color 14079702) ) ) ) (eval fonc1)(eval fonc2) (princ) )

Une suggestion! Tu l'ouvre dans la version "sans" COVADIS. Une fois ouvert tu colles ce qui suit en ligne de commande: ((lambda ( / ) (foreach p (entget (namedobjdict)) (if (and (= 3 (car p)) (or (wcmatch (cdr p) "COVA_*") (wcmatch (cdr p) "AEC_*")) ) (dictremove (namedobjdict) (cdr p)) ) ) (command "_.-purge" "_Regapps" "*" "_No") (command "_.-purge" "_All" "*" "_No") )) Et tu sauvegarde ce nouveau fichier! Si ça fonctionne, l'inconvénient est que tu risque de perdre tout le paramétrage de COVADIS, mais tu auras toutes tes entités graphiques. A voir, je ne peux pas tester...

En dérivé de la fonction proposé auparavant, sans trop l'avoir testé en situation réelle... ((lambda ( / js n ent dxf_ent val_txt l) (cond ((setq js (ssget '((0 . "MTEXT")))) (repeat (setq n (sslength js)) (setq ent (ssname js (setq n (1- n))) dxf_ent (entget ent) val_txt (cdr (assoc 1 dxf_ent)) ) (cond ((setq l (member 80 (reverse (vl-string->list val_txt)))) (if (eq (cadr l) 92) (entmod (subst (cons 1 (vl-list->string (reverse (cddr l)))) (assoc 1 dxf_ent) dxf_ent)) ) ) ) ) ) ) (prin1) ))

Salut, Comme gegematic, mais en sélection multiple (a copier-coller directement en ligne de commande) ((lambda ( / js n ent dxf_ent val_txt) (cond ((setq js (ssget '((0 . "MTEXT")))) (repeat (setq n (sslength js)) (setq ent (ssname js (setq n (1- n))) dxf_ent (entget ent) val_txt (cdr (assoc 1 dxf_ent)) ) (entmod (subst (cons 1 (substr val_txt 1 (vl-string-search "\\P" val_txt))) (assoc 1 dxf_ent) dxf_ent)) ) ) ) (prin1) ))

Et si tu mettait un progn à ta fonction if, parce que là il exécute soit l'un, soit l'autre (if (= (getvar "layermanagerstate") 0)(progn (initdia)(command "_.layer")))

Bonjour, Avec windows il peut être nécessaire de débloquer les dll Pour ce faire dans l'explorateur, click-droit sur le fichier et si dans l'onglet général" il est stipulé que ce fichier provient d'un autre ordinateur il est proposé de de le débloqué si tu lui fais confiance. Après ceci la commande pourra être lancée, si il n'est pas débloqué, il n'est pas chargé et tu as droit a commande inconnue.

Didier t'a répondu! Pour compléter un peu la réponse; (lambda) est une fonction anonyme, lorsque tu lance celle ci elle s’exécute mais ne reste pas en mémoire (elle n'est valable qu'une seule fois lors de son appel). Je fais souvent cela pour des tâches qui ne seront exécuter qu'une seule fois, car une fois toutes les entités traitées, la fonction devient inutile, donc aucune nécessité de la relancer. En faire une commande à l'aide de (defun C:) est inutile (bien que ça reste possible mai sans intérêt). Pourquoi encombrer la mémoire avec une commande qui ne sera plus utiliser ultérieurement dans la session? Lambda est bien pour des fonctions ponctuelles. NB: Cela n'empêche pas de déclarer les variables en local dans la fonction lambda pour éviter là aussi un encombrement inutile mais aussi d'éviter des conflit avec un autre programme qui aurait les même variables non déclarée en locale. Beaucoup de gens qui s'initient au lisp oublient souvent de déclarer leurs variables, bien que cela ne remette pas en cause leur code, cela peut produire des erreurs d’exécution que l'on peut avoir du mal a identifier pour dé-bugger.

Doublon

Bonjour, Également tous mes vœux pour cette nouvelle année. Ce qui me chiffonne dans ton code sans savoir ce que tu veux faire exactement sont celle effectivement qui utilise VIEWTWIST. tu a écris: (setq p16 (polar pins (+ 100 (/ (* 200 (getvar "VIEWTWIST")) pi)) -0.30)) ;et (setq Ang3 (+ 100 (/ (* 200 (getvar "VIEWTWIST")) pi)))) Je crois comprendre que tu as voulu convertir en grade, mais sache que la fonction (polar) ne prends que les angle en radian, donc la conversion est inutile. De plus ton code ne fonctionnerais correctement que dans un dessin défini en grade. Pour moi sans savoir le but exact, j'aurais écris simplement ceci: (setq p16 (polar pins (+ (* 0.5 pi) (getvar "VIEWTWIST")) -0.30))(setq Ang3 (+ (* 0.5 pi) (getvar "VIEWTWIST")))) Je ne sais pas si cette remarque va mettre fin à ton dysfonctionnement...

A ce propos, attention au datage de documents officiel, chèque etc... Évitez la notation 01/01/20 par exemple, mais préférer 01/01/2020. La première est falsifiable; on peut la transformer en 01/01/2015 par exemple et donc anti-dater un document.

Merci du retour, j'ai fais encore une petite modif (au cas ou ! ) pour que les objets prennent la couleur du calque et ne gardent pas leur couleur d'origine.

J'ai modifié le code en réponse #3.Normalement après quelque tests rapides, cela devrait fonctionner indifféremment avec les couleurs: ACI, RGB et Pantone...

Bonjour, Pour des entités ayant des couleurs vraies (RGB), j'avais écrit ça: ((lambda ( / js n dxf_ent c_true c_rgb l_name) (setq js (ssget "_X")) (cond (js (repeat (setq n (sslength js)) (setq c_true nil dxf_ent (entget (ssname js (setq n (1- n)))) c_true (if (assoc 420 dxf_ent) (cdr (assoc 420 dxf_ent)) nil) ) (if (and (not c_true) (assoc 62 dxf_ent)) (if (or (/= (cdr (assoc 62 dxf_ent)) 256) (/= (cdr (assoc 62 dxf_ent)) 0)) (setq c_true (cdr (assoc 62 dxf_ent))) (setq c_true 7) ) (if (not (assoc 62 dxf_ent)) (setq c_true 256)) ) (cond (c_true (if (> c_true 256) (setq c_rgb (mapcar '(lambda ( x ) (lsh (lsh (fix c_true) x) -24)) '(8 16 24)) l_name (apply 'strcat (mapcar 'strcat (mapcar 'itoa c_rgb) '("-" "-" ""))) ) (setq c_rgb c_true l_name (itoa c_rgb) ) ) (if (not (tblsearch "LAYER" l_name)) (entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 l_name) (cons 70 0) (if (> c_true 256) (cons 420 c_true) (cons 62 c_true) ) (cons 6 "Continuous") (cons 290 1) (cons 370 -3) ) ) ) (foreach el '(430 420) (if (assoc el dxf_ent) (entmod (setq dxf_ent (vl-remove (assoc el dxf_ent) dxf_ent))))) (entmod (subst (cons 8 l_name) (assoc 8 dxf_ent) (if (assoc 62 dxf_ent) (subst '(62 . 256) (assoc 62 dxf_ent) dxf_ent) dxf_ent) ) ) ) ) ) ) ) (prin1) ))

Ce que je peux te proposer écrit automatiquement un champ dynamique (lié à la polyligne ou autre objet fermé) (vl-load-com) (defun c:surf_curve-closed ( / AcDoc Space js nw_obj ename ent_text dxf_ent key) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (princ "\nSélectionnez un objet fermé") (while (setq js (ssget "_+.:E:S" '( (-4 . "<OR") (-4 . "<AND") (0 . "*POLYLINE") (-4 . "<AND") (-4 . "<NOT") (-4 . "&") (70 . 120) (-4 . "NOT>") (-4 . "&") (70 . 1) (-4 . "AND>") (-4 . "AND>") (0 . "CIRCLE") (-4 . "<AND") (0 . "SPLINE") (-4 . "&") (70 . 1) (-4 . "AND>") (-4 . "<AND") (0 . "ELLIPSE") (41 . 0.0) (42 . 6.283185307179586) (-4 . "AND>") (-4 . "OR>") ) ) ) (if (zerop (getvar "USERR1")) (setvar "USERR1" (/ (getvar "VIEWSIZE") 75.0))) (setq nw_obj (vla-addMtext Space (vlax-3d-point (trans (getvar "VIEWCTR") 1 0)) 0.0 (strcat "S="(rtos (vlax-get-property (setq ename (vlax-ename->vla-object (ssname js 0))) "Area") 2 2) "m²") ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation 'BackgroundFill 'Color) (list 1 (getvar "USERR1") 5 (getvar "TEXTSTYLE") (getvar "CLAYER") 0.0 -1 250) ) (setq ent_text (entlast) dxf_ent (entget ent_text) dxf_ent (subst (cons 90 1) (assoc 90 dxf_ent) dxf_ent) dxf_ent (subst (cons 63 255) (assoc 63 dxf_ent) dxf_ent) ) (entmod dxf_ent) (while (and (setq key (grread T 4 0)) (/= (car key) 3)) (cond ((eq (car key) 5) (setq dxf_ent (subst (cons 10 (trans (cadr key) 1 0)) (assoc 10 dxf_ent) dxf_ent)) (entmod dxf_ent) ) ) ) (vlax-put (vlax-ename->vla-object (entlast)) 'TextString (strcat "{\\fArial|b0|i0|c0|p34;" "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-ObjectID ename)) ">%).Area \\f \"%lu2%pr2%ps[s=," "m²]\">%" ) ) ) (prin1) )

Bonjour Guillaume, J'ai modifié le code au post #11 En plus du calque, j'ai répondu aussi, dans la foulée à une demande de Patrice; mettre aussi les données d'objet sur les polylignes de contour; qui peut le plus, peut le moins... Oui mais la demande aurait été au fond de la pile et je serais peut être passé à côté.Bonnes fêtes également aux CADiens

Franchement je ne vois pas comment, le code d'Evgeniy emploi des fonctions récursives et utilise (entmake) pour la création d'entité. Ce procédé est la meilleure façon, même mieux qu'ActiveX qui est pourtant très bien aussi au niveau rapidité et plus simple à construire. En NetC se serait peut être plus rapide mais je ne pratique pas. Pour en revenir au programme; Lecrabe m'a pointé du doigt un dysfonctionnement (non prise en compte des arrondis dans le Mpolygone).J'ai repris l'écriture et pense avoir résolu le problème, voici cette version. (defun createhatchlist (e) (if e (vl-remove-if-not '(lambda (x) (member (car x) '(10 42))) (entget e)) ) ) (defun entmakex-hatch (l a n s lay) ;; By ElpanovEvgeniy ;; L - list point ;; A - angle hatch ;; N - name pattern ;; S - scale ;; return - hatch ename (entmakex (apply 'append (list (list '(0 . "HATCH") '(100 . "AcDbEntity") '(410 . "Model") '(100 . "AcDbHatch") '(10 0.0 0.0 0.0) '(210 0.0 0.0 1.0) (cons 2 n) lay (if (= n "SOLID") '(70 . 1) '(70 . 0) ) ;_ if '(71 . 0) (cons 91 (length l)) ) ;_ list (apply 'append (mapcar '(lambda (a) (apply 'append (list (list '(92 . 7) '(72 . 1) '(73 . 1) (cons 93 (/ (length a) 2))) a '((97 . 0)) ) ;_ list ) ;_ apply ) ;_ lambda l ) ;_ mapcar ) ;_ apply (list '(75 . 0) '(76 . 1) (cons 52 a) (cons 41 s) '(77 . 0) '(78 . 1) (cons 53 a) '(43 . 0.) '(44 . 0.) '(45 . 1.) '(46 . 1.) '(79 . 0) '(47 . 1.) '(98 . 2) '(10 0. 0. 0.0) '(10 0. 0. 0.0) '(451 . 0) '(460 . 0.0) '(461 . 0.0) '(452 . 1) '(462 . 1.0) '(453 . 2) '(463 . 0.0) '(463 . 1.0) '(470 . "LINEAR") ) ;_ list ) ;_ list ) ;_ apply ) ;_ entmakex ) (defun f (l i) (if (> i 0) (if (assoc 42 l) (cons (mapcar (function +) (car (member (assoc 10 l) l)) v) (cons (assoc 42 l) (f (cddr (member (assoc 10 l) l)) (1- i)))) (cons (mapcar (function +) (car (member (assoc 10 l) l)) v) (f (cdr (member (assoc 10 l) l)) (1- i))) ) ) ) (defun c:MP2PHATCHOD (/ hList tmp e dxf_e jspl v tbldef lst_data numrec tmp_rec nwent ct l lst ll p nbe) ;; by ElpanovEvgeniy, modified by Valsecchi Bruno ;; convert MPolygon to Lwpolyline and Hatch with OD for map ;; version 0.2 ;; 2012.07.11 ;; mailto: elpanov@gmail.com ;; web: elpanov.com (if (setq v (ssget '((0 . "MPOLYGON")))) (foreach e (mapcar (function cadr) (ssnamex v)) (setq hList nil tmp nil lst_data nil) (cond ((eq (type e) 'ENAME) (foreach n (ade_odgettables e) (setq tbldef (ade_odtabledefn n)) (setq lst_data (cons (mapcar '(lambda (fld / tmp_rec numrec) (setq numrec (ade_odrecordqty e n)) (cons n (while (not (zerop numrec)) (setq numrec (1- numrec)) (if (zerop numrec) (if tmp_rec (cons fld (list (cons (ade_odgetfield e n fld numrec) tmp_rec))) (cons fld (ade_odgetfield e n fld numrec)) ) (setq tmp_rec (cons (ade_odgetfield e n fld numrec) tmp_rec)) ) ) ) ) (mapcar 'cdar (cdaddr tbldef)) ) lst_data ) ) ) (setq dxf_e (entget e) jspl (ssadd) v (cons 0 (mapcar (function -) (cdr (assoc 11 dxf_e)) (cdr (assoc 10 dxf_e)))) l (vl-remove nil (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (assoc 67 dxf_e) (assoc 410 dxf_e) (assoc 8 dxf_e) (if (assoc 63 dxf_e) (cons 62 (cdr (assoc 63 dxf_e))) ) (if (assoc 421 dxf_e) (cons 420 (cdr (assoc 421 dxf_e))) ) '(100 . "AcDbPolyline") ) ) lst dxf_e ll nil ) (while (setq lst (member (assoc 93 (cdr lst)) (cdr lst))) (setq p (f (cdr lst) (cdar lst)) ll (append ll (list '(92 . 7) '(72 . 0) '(73 . 1) (car lst)) p '((97 . 0))) ) (entmakex (vl-remove nil (append l (list (cons 90 (cdar lst)) '(70 . 1)) p (list (assoc 210 dxf_e))))) (setq nwent (entlast)) (cond (lst_data (mapcar '(lambda (x / ct) (while (< (ade_odrecordqty nwent (caar x)) (ade_odrecordqty (cdar dxf_e) (caar x))) (ade_odaddrecord nwent (caar x)) ) (foreach el (mapcar 'cdr x) (if (listp (cdr el)) (progn (setq ct -1) (mapcar '(lambda (y / ) (ade_odsetfield nwent (caar x) (car el) (setq ct (1+ ct)) y) ) (cadr el) ) ) (ade_odsetfield nwent (caar x) (car el) 0 (cdr el)) ) ) ) lst_data ) ) ) (setq jspl (ssadd nwent jspl)) ) (repeat (setq nbe (sslength jspl)) (if (setq tmp (CreateHatchList (ssname jspl (setq nbe (1- nbe))))) (setq hList (cons tmp hList)) ) ) ) ) (entmakex-hatch (reverse hList) 0.0 "_SOLID" 1.0 (assoc 8 dxf_e)) (setq nwent (entlast)) (cond (lst_data (mapcar '(lambda (x / ct) (while (< (ade_odrecordqty nwent (caar x)) (ade_odrecordqty (cdar dxf_e) (caar x))) (ade_odaddrecord nwent (caar x)) ) (foreach el (mapcar 'cdr x) (if (listp (cdr el)) (progn (setq ct -1) (mapcar '(lambda (y / ) (ade_odsetfield nwent (caar x) (car el) (setq ct (1+ ct)) y) ) (cadr el) ) ) (ade_odsetfield nwent (caar x) (car el) 0 (cdr el)) ) ) ) lst_data ) ) ) ) ) (princ) )

Bonjour Patrice, A vrai dire je n'avais pas trop testé en profondeur la procédure d'Evgeniy. Mes tests superficiel sur Map 2019 avaient fonctionné.Mais je crois avoir découvert une coquille sur : (mapcar (function cadr) (ssnamex v))Cette fonction ne retourne pas qu'une liste d'entité, mais peut avoir en plus parfois une liste concernant le mode de sélection effectué et dans ce cas ne répond pas aux arguments demandés par la suite dans le code.Je rectifie le code précédent en rajoutant un contrôle sur cette liste.

Bonjour, J'ai modifié le lisp d'Evgeniy, à voir si ça convient.... (defun c:mp2p (/ L LL LST P V tbldef lst_data numrec tmp_rec nwent ct) ;; by ElpanovEvgeniy ;; convert MPolygon to Lwpolyline ;; version 0.2 ;; 2012.07.11 ;; mailto: elpanov@gmail.com ;; web: elpanov.com (if (setq v (ssget "_X" '((0 . "MPOLYGON")))) (foreach e (mapcar 'cadr (ssnamex v)) (cond ((eq (type e) 'ENAME) (foreach n (ade_odgettables e) (setq tbldef (ade_odtabledefn n)) (setq lst_data (cons (mapcar '(lambda (fld / tmp_rec numrec) (setq numrec (ade_odrecordqty e n)) (cons n (while (not (zerop numrec)) (setq numrec (1- numrec)) (if (zerop numrec) (if tmp_rec (cons fld (list (cons (ade_odgetfield e n fld numrec) tmp_rec))) (cons fld (ade_odgetfield e n fld numrec)) ) (setq tmp_rec (cons (ade_odgetfield e n fld numrec) tmp_rec)) ) ) ) ) (mapcar 'cdar (cdaddr tbldef)) ) lst_data ) ) ) (setq e (entget e) v (cons 0 (mapcar (function -) (cdr (assoc 11 e)) (cdr (assoc 10 e)))) l (vl-remove nil (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (assoc 67 e) (assoc 410 e) (assoc 8 e) (if (assoc 63 e) (cons 62 (cdr (assoc 63 e))) ) (if (assoc 421 e) (cons 420 (cdr (assoc 421 e))) ) '(100 . "AcDbPolyline") ) ) lst e ll nil ) (defun f (l i) (if (> i 0) (cons (mapcar (function +) (car l) v) (f (cdr l) (1- i))) ) ) (while (setq lst (member (assoc 93 (cdr lst)) (cdr lst))) (setq p (f (cdr lst) (cdar lst)) ll (append ll (list '(92 . 7) '(72 . 0) '(73 . 1) (car lst)) p '((97 . 0))) ) (entmakex (vl-remove nil (append l (list (cons 90 (cdar lst)) '(70 . 1)) p (list (assoc 210 e))))) ) (entmakex (vl-remove nil (append (list '(0 . "HATCH") '(100 . "AcDbEntity") (assoc 410 l) (assoc 8 l) (assoc 62 l) (assoc 420 l) '(100 . "AcDbHatch") (assoc 10 e) (assoc 210 e) '(2 . "SOLID") (assoc 70 e) (assoc 71 e) (assoc 91 e) ) ll (list '(75 . 0) '(76 . 1) '(47 . 1.) '(98 . 2) '(10 0. 0. 0.0) '(10 0. 0. 0.0) '(450 . 0) '(451 . 0) '(460 . 0.0) '(461 . 0.0) '(452 . 0) '(462 . 0.0) '(453 . 2) '(463 . 0.0) '(63 . 256) '(463 . 1.0) '(63 . 256) '(470 . "LINEAR") ) ) ) ) (setq nwent (entlast)) (cond (lst_data (mapcar '(lambda (x / ct) (while (< (ade_odrecordqty nwent (caar x)) (ade_odrecordqty (cdar e) (caar x))) (ade_odaddrecord nwent (caar x)) ) (foreach el (mapcar 'cdr x) (if (listp (cdr el)) (progn (setq ct -1) (mapcar '(lambda (y / ) (ade_odsetfield nwent (caar x) (car el) (setq ct (1+ ct)) y) ) (cadr el) ) ) (ade_odsetfield nwent (caar x) (car el) 0 (cdr el)) ) ) ) lst_data ) ) ) ) ) ) ) (princ) )

Salut,Un petit sketch de nos voisins suisses.

Ce qui pose problème dans ton dessin est l'utilisation de la couleur codée sur 24 bit (code DXF 420) Si l'on l'enlève cela à l'air de fonctionner. Hommage à Patrick_35 Rajouter dans la boucle (while b (if (cdr (assoc 420 B)) (setq b (vl-remove (assoc 420 B) B)) ) PS: Je n'arrive pas à mettre le code en entier, j'ai le message suivant:

Ceci devrait pouvoir le faire (vl-load-com) (defun c:Pt2MidVtx ( / js AcDoc Space n obj dxf_ent ename pr) (princ "\nSélectionnez une polyligne.") (setq js (ssget '((0 . "*POLYLINE")))) (cond (js (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 obj (ssname js (setq n (1- n))) dxf_ent (entget obj) ename (vlax-ename->vla-object obj) pr -0.5 ) (repeat (fix (vlax-curve-getEndParam ename)) (entmake (list '(0 . "POINT") '(100 . "AcDbEntity") (assoc 67 dxf_ent) (assoc 410 dxf_ent) (assoc 8 dxf_ent) (if (assoc 62 dxf_ent) (assoc 62 dxf_ent) '(62 . 256)) (if (assoc 6 dxf_ent) (assoc 6 dxf_ent) '(6 . "ByLayer")) (if (assoc 48 dxf_ent) (assoc 48 dxf_ent) '(48 . 0.0)) (if (assoc 370 dxf_ent) (assoc 370 dxf_ent) '(370 . 0)) '(100 . "AcDbPoint") (cons 10 (trans (vlax-curve-getpointatparam obj (setq pr (1+ pr))) 0 obj)) (if (assoc 39 dxf_ent) (assoc 39 dxf_ent) '(39 . 0.0)) (assoc 210 dxf_ent) ) ) ) ) ) ) (prin1) )