bonuscad

Bonjour, Pour ma part, je prendrais dans les "pilotes de base" le "HP Windows HPGL2 Driver" Autocad fonctionne parfaitement avec ce type de driver qui est pour du vectoriel. Compléter l'installation dans Autocad par le "Gestionnaire de traçage...", tu devrais trouvé le fabricant HP et son modèle: Si pas présent prendre LHPGL ou SHPGL. Voir aussi si le traceur est concerné par les "Micrologiciel". Le Postscript est plutôt destiné au format PDF (Bitmap)

@Luna En Même Autodesk ne fait pas beaucoup d'effort... Au temps des version DOS, le logiciel été livré avec manuel papier de programmation en "Français", gratuitement jusqu'à la version R13 payant à partir de R14 (Manuel que je possède d'ailleurs et que je garde précieusement) Donc logiquement ils ont les sources numérique de ces fichier d'aide anciens, une mise à jour serait simple, sans parler des nouvelles fonctions vl ou vlax qui là demande un travail certain.

C'est vrai que RECHERCHER ne fonctionne pas avec les scripts. Mais on peut malgré tout le faire avec un script. En partant de la solution donné ICI ont peut utiliser le script avec AcCoreConsole et une fonction lisp exécuté dans chaque fichier automatiquement. Suivre la procédure donné dans la discussion ((lambda ( / f_exe ShlObj Folder FldObj Out_Fld file_scr file_bat) (vl-load-com) (setq f_exe (findfile "accoreconsole.exe")) (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) ) ) (setq file_scr (open (strcat (getvar "ROAMABLEROOTPREFIX") "support\\update.scr") "w")) (write-line "((lambda ( / js n dxf_ent)" file_scr) (write-line " (setq js (ssget \"_X\" '((0 . \"*TEXT\"))))" file_scr) (write-line " (cond" file_scr) (write-line " (js" file_scr) (write-line " (repeat (setq n (sslength js))" file_scr) (write-line " (setq dxf_ent (entget (ssname js (setq n (1- n)))))" file_scr) (write-line " (if (vl-string-search \"%%C\" (cdr (assoc 1 dxf_ent)))" file_scr) (write-line " (entmod" file_scr) (write-line " (subst" file_scr) (write-line " (cons 1 (vl-string-subst \"ø\" \"%%C\" (cdr (assoc 1 dxf_ent))))" file_scr) (write-line " (assoc 1 dxf_ent)" file_scr) (write-line " dxf_ent" file_scr) (write-line " )" file_scr) (write-line " )" file_scr) (write-line " )" file_scr) (write-line " )" file_scr) (write-line " )" file_scr) (write-line " )" file_scr) (write-line " (prin1)" file_scr) (write-line "))" file_scr) (write-line "(command \"_.save\" \"\")" file_scr) (close file_scr) (setq file_bat (open (strcat (getvar "ROAMABLEROOTPREFIX") "support\\update.bat") "w")) (write-line (eval (read "(strcat \"set accoreexe=\" \"\\\"\" f_exe \"\\\"\")")) file_bat) (write-line (eval (read "(strcat \"set source=\" \"\\\"\" Out_Fld \"\\\"\")")) file_bat) (write-line (eval (read "(strcat \"set script=\" \"\\\"\" (getvar \"ROAMABLEROOTPREFIX\") \"support\\\\update.scr\" \"\\\"\")")) file_bat) (write-line "FOR /f \"delims=\" %%f IN ('dir /b \"%source%\\\*.dwg\"') DO %accoreexe% /i \"%source%\\%%f\" /s %script%" file_bat) (close file_bat) (startapp (strcat (getvar "ROAMABLEROOTPREFIX") "support\\update.bat")) (princ"\Job finished") (prin1) ))

Si tu ne veux qu'utiliser des commandes standard d'autocad (pas de commandes de produit verticaux ex: commande mapinsert d'autocadmap) et un peu de lisp (vanilla, pas activeX), la solution accoreconsole est sympa, plus rapide car elle n'utilise pas le moteur graphique d'autocad. Un exemple à adapter, celui ci enlève les dictionnaires de produit verticaux (Covadis, Architecture) du dessin,purge, fait un contrôle du fichier et enregistre au format 2013. Pour exécuter cela il suffit de copier-coller le code dans un nouveau dessin et de désigner le dossier à traiter. ((lambda ( / f_exe ShlObj Folder FldObj Out_Fld file_scr file_bat) (vl-load-com) (setq f_exe (findfile "accoreconsole.exe")) (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) ) ) (setq file_scr (open (strcat (getvar "ROAMABLEROOTPREFIX") "support\\update.scr") "w")) (write-line "((lambda ( / ) (foreach p (entget (namedobjdict)) (if (and (= 3 (car p)) (or (wcmatch (cdr p) \"COVA_*\") (wcmatch (cdr p) \"AEC_*\"))) (dictremove (namedobjdict) (cdr p))))))" file_scr) (write-line "(command \"_.audit\" \"_Yes\")" file_scr) (write-line "(command \"_.-purge\" \"_Regapps\" \"*\" \"_No\")" file_scr) (write-line "(command \"_.-purge\" \"_All\" \"*\" \"_No\")" file_scr) (write-line "(command \"_.saveas\" \"_LT2013\" \"\" \"_Yes\")" file_scr) (close file_scr) (setq file_bat (open (strcat (getvar "ROAMABLEROOTPREFIX") "support\\update.bat") "w")) (write-line (eval (read "(strcat \"set accoreexe=\" \"\\\"\" f_exe \"\\\"\")")) file_bat) (write-line (eval (read "(strcat \"set source=\" \"\\\"\" Out_Fld \"\\\"\")")) file_bat) (write-line (eval (read "(strcat \"set script=\" \"\\\"\" (getvar \"ROAMABLEROOTPREFIX\") \"support\\\\update.scr\" \"\\\"\")")) file_bat) (write-line "FOR /f \"delims=\" %%f IN ('dir /b \"%source%\\\*.dwg\"') DO %accoreexe% /i \"%source%\\%%f\" /s %script%" file_bat) (close file_bat) (startapp (strcat (getvar "ROAMABLEROOTPREFIX") "support\\update.bat")) (princ"\Job finished") (prin1) ))

Bonjour Max73 et bienvenu. Malheureusement Usegomme ne fréquente plus ce forum depuis 2015; il doit être à la retraite et ne plus se soucier d'Autocad... Heureusement pour toi comme j'ai pendant un temps conversé à propos du lisp avec lui (je ne suis pas tuyauteur et aussi à la retraite), j'ai encore son programme (dernière version, je pense) sur mon PC. Je joins le fichier pour qu'il reste sur le site. Merci à Usegomme pour son partage et de voir qu'on s’intéresse à son travail (que ferait t'on sans les vieux 😜) TUY.LSP

Comme l'a suggéré (gile) avec les fonctions (vl-*** Seul bémol si le caractère "." ou "-" se trouve n'importe où dans la chaîne, cela peut donner un résultat erroné! (defun extract_num4str (str / ) (atof (vl-list->string (vl-remove-if '(lambda (x) (or (< x 45) (> x 57))) (vl-string->list str)))) )

Tu sais je n'ai pas fais un gros effort, c'est surtout mon PC qui a bossé !.. Voir ce sujet !

((lambda ( / Rep) (if (not LiGbBt) (setq LiGbBt "Oui")) (initget "Oui Non") (while (or (setq Rep (getkword (strcat "\nLiaison en attente sur semelle [Oui/Non] <" LiGbBt "> : "))) (null Rep)) (if (not Rep) (setq Rep LiGbBt) ) (set 'LiGbBt Rep) (princ (strcat "\nLiGbBt=" LiGbBt)) (initget "Oui Non") ) (prin1) )) Pour tester et comprendre la fonction (Esc pour sortir de la boucle) (if (not LiGbBt) (setq LiGbBt "Oui")) (initget "Oui Non") (if (not (setq rep (getkword (strcat "\nLiaison en attente sur semelle [Oui/Non] <" LiGbBt "> : ")))) (setq Rep LiGbBt) ) (set 'LiGbBt Rep) (princ (strcat "\nLiGbBt=" LiGbBt)) (prin1) Le code simple à intégrer dans ton code Note l'usage de (set 'LiGbBt Rep)

Regarde si tu as un fichier .LCK ou .DWL avec le même nom que ton dessin. Si existence, cela veut dire qu'Autocad considère ton fichier comme déjà utilisé par un utilisateur. Cela arrive parfois après un plantage que ce type de fichier reste. Normalement avec une sortie propre Autocad efface ces fichiers. La solution: supprimer manuellement ces fichiers... Pas sur de ma réponse parce que je n'ai jamais vu de cadenas à côté du nom de fichier. C'est un fichier sur un réseau?

Pour AutocadMap, je le joindrais si demande de ta part! (limité en envoi)

Bonjour, Est ce que ces fichiers DWG ont le même défaut. (je ne sais pas si tu utilise Map, donc j'ai fais les deux) Il y a commune Montmirail fait sur AutocadMap avec des données d'objet et des Mpolygones et commune Montmirail_XDATA lisible sur un Autocad classique avec des données étendues et des polylignes, ces données peuvent être lues avec la commande XDLIST des ExpressTools ou avec ce bout de code lues en dynamique Ces dessins ont été fait avec ceux mis en ligne sur site du cadastre en date du 16 Décembre 2021 (defun c:read_XD ( / AcDoc Space nw_obj ent_text dxf_ent ncol strcatlst Input obj_sel ename elist xd_list fldnamelist strcatlst) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) nw_obj (vla-addMtext Space (vlax-3d-point (trans (getvar "VIEWCTR") 1 0)) 0.0 "" ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation 'BackgroundFill 'Color) (list 1 (/ (getvar "VIEWSIZE") 100.0) 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) ncol 0 strcatlst "" ) (entmod dxf_ent) (while (and (setq Input (grread T 4 2)) (= (car Input) 5)) (cond ((setq obj_sel (nentselp (cadr Input))) (if (eq (type (car (last obj_sel))) 'ENAME) (setq ename (car (last obj_sel))) (setq ename (car obj_sel)) ) (if (eq (cdr (assoc 0 (entget ename))) "VERTEX") (setq ename (cdr (assoc 330 (entget ename))))) (setq elist (entget ename (list "*")) xd_list (cdr (assoc -3 elist)) fldnamelist (mapcar 'car xd_list) ncol 0 strcatlst "" ) (cond (fldnamelist (foreach tbl fldnamelist (setq ncol (1+ ncol)) (foreach f (mapcar 'cdr (cdr (assoc tbl xd_list))) (setq value (cond ((eq (type f) 'STR) f) ((eq (type f) 'INT) (itoa f)) ((eq (type f) 'REAL) (rtos f 2 2)) ((eq (type f) 'LIST) (strcat (rtos (car f) 2 2) "," (rtos (cadr f) 2 2) "," (rtos (caddr f) 2 2))) (T "") ) strcatlst (strcat strcatlst "{\\C" (itoa ncol) ";" tbl "} : " value "\n" ) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'InsertionPoint 'AttachmentPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation 'TextString) (list (trans (cadr Input) 1 0) 1 (/ (getvar "VIEWSIZE") 100.0) 5 (getvar "TEXTSTYLE") (getvar "CLAYER") 0.0 (strcat "{\\fArial;" strcatlst "}" )) ;"TechnicBold" ) ) ) ) ) ) ) (vla-Delete nw_obj) (prin1) ) commune Montmirail_XDATA.dwg

Bonjour, Un début de code qui fera le cumul des longueurs, pour les polylignes les segments droit ou arrondis sont dissociés en ligne et arc. Copier-coller le code directement en ligne de commande pour faire un test ((lambda ( / js n ename obj dxf_ent lay tl l_tl l_lay pr lg_arc lg_line dist_start dist_ent pt_start pt_end seg_len bulge cumul_line cumul_arc nw_list_l nw_list_a) (vl-load-com) (princ "\nSélectionnez des objets POLYLIGNE, LIGNE, ARC, CERCLE") (setq js (ssget (list '(0 . "*POLYLINE,LINE,ARC,CIRCLE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) '(-4 . "<NOT") '(-4 . "&") '(70 . 112) '(-4 . "NOT>") ) ) ) (cond (js (repeat (setq n (sslength js)) (setq ename (ssname js (setq n (1- n))) obj (vlax-ename->vla-object ename) dxf_ent (entget ename) lay (cdr (assoc 8 dxf_ent)) tl (cdr (assoc 6 dxf_ent)) ) (if (null tl) (setq tl (cdr (assoc 6 (tblsearch "LAYER" lay))))) (if (not (member tl l_tl)) (setq l_tl (cons tl l_tl))) (if (not (member lay l_lay)) (setq l_lay (cons lay l_lay))) (cond ((wcmatch (cdr (assoc 0 dxf_ent)) "*POLYLINE") (setq pr -1 lg_arc 0.0 lg_line 0.0 ) (repeat (fix (vlax-curve-getEndParam obj)) (setq dist_start (vlax-curve-GetDistAtParam obj (setq pr (1+ pr))) dist_end (vlax-curve-GetDistAtParam obj (1+ pr)) pt_start (vlax-curve-GetPointAtParam obj pr) pt_end (vlax-curve-GetPointAtParam obj (1+ pr)) seg_len (- dist_end dist_start) bulge (if (equal seg_len (distance pt_start pt_end) 1E-06) 0 1) ) (if (zerop bulge) (setq lg_line (+ lg_line seg_len)) (setq lg_arc (+ lg_arc seg_len)) ) ) (setq cumul_line (cons (cons (cons lay tl) lg_line) cumul_line) cumul_arc (cons (cons (cons lay tl) lg_arc) cumul_arc) ) ) (T (cond ((eq (vla-get-ObjectName obj) "AcDbArc") (setq cumul_arc (cons (cons (cons lay tl) (vlax-get-property obj "ArcLength")) cumul_arc)) ) ((eq (vla-get-ObjectName obj) "AcDbCircle") (setq cumul_arc (cons (cons (cons lay tl) (vlax-get-property obj "Circumference")) cumul_arc)) ) (T (setq cumul_line (cons (cons (cons lay tl) (vlax-get-property obj "Length")) cumul_line)) ) ) ) ) ) (foreach i l_lay (foreach k l_tl (setq l_sort (vl-remove-if-not '(lambda (x) (equal (car x) (cons i k))) cumul_line)) (if l_sort (setq nw_list_l (cons (list (caar l_sort) (apply '+ (mapcar 'cdr l_sort))) nw_list_l)) ) (setq l_sort (vl-remove-if-not '(lambda (x) (equal (car x) (cons i k))) cumul_arc)) (if l_sort (setq nw_list_a (cons (list (caar l_sort) (apply '+ (mapcar 'cdr l_sort))) nw_list_a)) ) ) ) ;A PARTIR D'ICI ON EXPLOITE LES VARIABLES "nw_list_l" et "nw_list_a" COMME ON VEUT(un tableau, du texte, un fichier...) ;nw_list_l pour les LIGNES ;new_list_a pour les ARCS ; pour chaque élément de la liste ; le CAR de la liste donne la paire pointée Calque et Type de ligne. ; le CDR donne la somme des éléments (print nw_list_l)(print nw_list_a) ) ) (prin1) )) Après comme dit dans le code on exploite le résultat comme on le désire...

Bon réveillon à tous les membres! Bien que que plus discret depuis ma retraite, j'ai toujours plaisir à vous lire. La roue tourne, de nouveaux membres deviennent très actifs (il en faudrait plus), mais un remerciements particulier à @Luna qui s'investit beaucoup dans la partie programmation et une pensée à notre regretté Patrick_35. Je vous souhaite une bonne année 2022 à tous et surtout que cette situation (qui ont put créer des clivages) prenne fin, car sérieusement ça commence à saouler grave... pour en revenir à des relations humaines dignes de nôtre époque. Je vous souhaite le meilleur...

Bonjour, Je vais faire une suggestion à Cadmin. Je vois que le site emploi la technologie "Invision Community" Or un site basé au Etats-Unis d'Amérique - > cadtutor (forum Autocad) utilise la même technologie. Sur ce site que je consulte (pas inscris!), je n'ai jamais observé de spams. Ne serait-il pas judicieux de rentrer en contact avec l'admin de ce site pour savoir quelles règles/procédures il utilise pour palier à ce problème qui est chronophage pour ceux qui s'en occupent ? En effet s'il a trouvé des solutions, pourquoi les réinventer?

Un peu la même technique qu'Olivier. REMPLIR Inactif Tracer seulement le calque incriminé avec un traceur DXB (Assistant Ajouter un traceur si nécessaire) avec une résolution maximale pour un rendu à résolution correcte. Dans un nouveau fichier utiliser la commande CHARGDXB (_DXBIN) A partir de ce moment du va obtenir des lignes de contour, avec pedit multiple (peut être en 2 passes) tu va pouvoir les transformer en polylignes et les joindre. Dès lors tu pourra y appliquer un type de ligne pour ces contours (cache?) avec une échelle personnalisée pour ces objets. Ce qui va être un peu pénible c'est la mise à l'échelle et la rotation: tu peux attacher ton dessin original en xref pour t'aider. Mettre peut être des point de référence commun pour les 2 dessins (avant traçage) pour faciliter cette opération.

Tu as aussi simplement l'aide d'autocad. Les exemples sont en VBA et lisp pour la plupart des fonctions, cela aide beaucoup... https://help.autodesk.com/view/OARX/2020/ENU/?guid=GUID-5D302758-ED3F-4062-A254-FB57BAB01C44

ou simplement une petite macro dans un bouton ^C^C_.break \_first \@ ^M;

L'énoncé et le code ne sont pas très clair sur le but à atteindre... Mais pour le peu que j'ai compris, je modifierais le code comme suit, si c'est pas vraiment le but, cela te donnera peut être des pistes? (defun c:toto ( / doc txt nw_txt) (vl-load-com) ;charge le support ActiveX complet (setq doc (vla-get-Activedocument (vlax-get-acad-object))) ;; Accès au dessin courant d'AutoCAD. ;; ;"vla-get-Activedocument" : Accéder au document actif / "vlax-get-acad-object" : Accéder à "l'objet" AutoCAD (if (and (setq txt (car (nentsel "\nSéléctionnez un texte ou un attribut source: "))) ;Le "setq" crée la valeur "txt" qui recuperera le nom d'entité du texte selectionné en premant la premiere liste "ename" avec "car" (member (vla-get-ObjectName (setq txt (vlax-ename->vla-object txt))) ;"member" renvoie la liste tromqué a partir de vla-get-ObjectName ;"vlax-ename->vla-object txt" : Conversion d'une entité (ename) en VLA-OBJECT pour le texte. '("AcDbAttribute" "AcDbMText" "AcDbText") ;dans les sous classe attributs, multi-texte et texte ) ) (while (setq nw_txt (nentsel "\nSéléctionnez un texte ou un attribut cible: ")) (cond ((member (vla-get-ObjectName (setq nw_txt (vlax-ename->vla-object (car nw_txt)))) '("AcDbAttribute" "AcDbMText" "AcDbText")) (vla-put-textstring nw_txt ;----------------------------------------------------------------------------------- (strcat ;Concaténation de plusieurs chaînes de caractères "%<\\AcObjProp Object(%<\\_ObjId " (vla-GetObjectIdString (vla-get-Utility doc) txt :vlax-false) ">%).TextString \\f \"%tc1\">%" ) ;----------------------------------------------------------------------------------- ) (vla-regen Doc acactiveviewport) ) ) ) ) (prin1) )

Ce que j'aime avec Didier, c'est que j’élargis mon vocabulaire... moi l'inculte! Amicalement

@Olivier Eckmann Bonjour, merci pour la précision, mais ne pouvant tester cette situation, je laisse les personnes concernées faire la modification suggérée ,si besoin, pour régler ce point précis.

Un peu tardivement... mais avec une version pleine (donc pas une LT), il y a un moyen de saisir un point dans un script. La fonction autolisp (grread) permet cela, c'est la seule fonction autolisp qui n'interrompe pas un script, mais il faudra jouer avec RESOL pour pouvoir avoir une cordonnée arrondie au décimale désirée. J'avais évoqué cette solution en 2004 dans cette réponse.

Je ne pense pas! Mon dernier fichier sur mon PC date du 22/01/2021 (donc postérieur au post). Je pense avoir introduit le fuzz (après des tests ultérieurs) pour les grandes coordonnées car la fonction pouvait ne pas faire le job dans ces cas là.

Toujours dans la même philosophie (conserver les OD avec n-record et XData), j'ai cette routine pour couper des LWPOLYLINE. Elle permet donc de sectionner en (n) tronçons une ou des polylignes en une seule opération avec des objets POINT, CERCLE ou INSERTION de blocs situés sur la polyligne. (vl-load-com) (defun add_vtx (obj add_pt ent_name fz / sw ew nw bulg next) (vla-GetWidth obj (fix add_pt) 'sw 'ew) (vla-addVertex obj (1+ (fix add_pt)) (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble (cons 0 1)) (list (car (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name)) (cadr (trans (vlax-curve-getpointatparam obj add_pt) 0 ent_name)) ) ) ) ) (setq next (1+ (fix add_pt))) (while (equal (vlax-curve-getdistatparam obj next) (vlax-curve-getdistatparam obj (fix add_pt)) fz) (setq next (1+ next)) ) (setq nw (* (/ (- ew sw) (- (vlax-curve-getdistatparam obj next) (vlax-curve-getdistatparam obj (fix add_pt))) ) (- (vlax-curve-getdistatparam obj add_pt) (vlax-curve-getdistatparam obj (fix add_pt))) ) bulg (atan (vla-GetBulge obj (fix add_pt))) ) (vla-SetBulge obj (fix add_pt) (/ (sin (* 4 bulg (- add_pt (fix add_pt)) 0.25)) (cos (* 4 bulg (- add_pt (fix add_pt)) 0.25)) ) ) (vla-SetBulge obj (1+ (fix add_pt)) (/ (sin (* 4 bulg (- (1+ (fix add_pt)) add_pt) 0.25)) (cos (* 4 bulg (- (1+ (fix add_pt)) add_pt) 0.25)) ) ) (vla-SetWidth obj (fix add_pt) sw (+ nw sw) ) (vla-SetWidth obj (1+ (fix add_pt)) (+ nw sw) ew ) (vla-update obj) ) (defun c:break_lw@pt_withOD ( / js typ_ent js_b dfzz i ent obj dxf_obj xd_l tbldef lst_data nb tmp_name pt lst_pt dxf_10 el_l l1 l2 c r nwent) (princ "\nSélection des LWPOLYLINE à couper") (while (not (setq js (ssget (list (cons 0 "LWPOLYLINE") (cons 67 (if (eq (getvar "CVPORT") 2) 0 1)) (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB"))) ) ) ) ) ) (initget "POINT CERCLE INSERTION _POINT CIRCLE INSERT") (setq typ_ent (getkword "\nCouper avec [POINT/CERCLE/INSERTION]? <POINT>: ")) (if (not typ_ent) (setq typ_ent "POINT")) (princ (strcat "\nSélection des " typ_ent " situés sur les polylignes")) (while (not (setq js_b (ssget (list (cons 0 typ_ent) (cons 67 (if (eq (getvar "CVPORT") 2) 0 1)) (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB"))) ) ) ) ) ) (cond ((and js js_b) (initget 6 "1E-01 1E-08") (setq dfzz (getreal "\nPrécision d'égalité; grandes coordonnée x xxx xxx.xx,y yyy yyy.yy / normales xxxx.xx,yyyy.yy [1E-01/1E-08]?<1E-01>: ")) (if (not dfzz) (setq dfzz 1E-01)) (repeat (setq i (sslength js)) (setq ent (ssname js (setq i (1- i))) obj (vlax-ename->vla-object ent) dxf_obj (entget ent (list "*")) xd_l (assoc -3 dxf_obj) lst_pt nil lst_data nil r nil ) (if (or (numberp (vl-string-search "Map 3D" (vla-get-caption (vlax-get-acad-object)))) (numberp (vl-string-search "Civil 3D" (vla-get-caption (vlax-get-acad-object)))) ) (progn (foreach n (ade_odgettables ent) (setq tbldef (ade_odtabledefn n)) (setq lst_data (cons (mapcar '(lambda (fld / tmp_rec numrec) (setq numrec (ade_odrecordqty ent n)) (cons n (while (not (zerop numrec)) (setq numrec (1- numrec)) (if (zerop numrec) (if tmp_rec (cons fld (list (cons (ade_odgetfield ent n fld numrec) tmp_rec))) (cons fld (ade_odgetfield ent n fld numrec)) ) (setq tmp_rec (cons (ade_odgetfield ent n fld numrec) tmp_rec)) ) ) ) ) (mapcar 'cdar (cdaddr tbldef)) ) lst_data ) ) ) ) (setq lst_data nil) ) (repeat (setq nb (sslength js_b)) (setq tmp_name (ssname js_b (setq nb (1- nb)))) (cond (tmp_name (setq pt (cdr (assoc 10 (entget tmp_name)))) (if (and (equal (distance pt (vlax-curve-getClosestPointTo ent pt)) 0.0 dfzz) (not (equal (distance pt (vlax-curve-getStartPoint ent)) 0.0 dfzz)) (not (equal (distance pt (vlax-curve-getEndPoint ent)) 0.0 dfzz)) ) (setq lst_pt (cons pt lst_pt)) ) ) ) ) (setq dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))) (cond ((and lst_pt (listp lst_pt)) (foreach el lst_pt (if (not (member T (mapcar '(lambda (x) (equal (list (car el) (cadr el)) x dfzz)) dxf_10))) (add_vtx obj (vlax-curve-getparamatpoint ent (vlax-curve-getClosestPointTo ent el)) ent dfzz) ) ) (setq el_l (entget ent)) (foreach n el_l (if (member (car n) '(-1 5 102 330 360)) (setq el_l (vl-remove (assoc (car n) el_l) el_l)))) (setq l1 (reverse (cdr (member (assoc 10 el_l) (reverse el_l)))) l1 (subst '(70 . 0) (assoc 70 l1) l1) l2 (reverse (cdr (reverse (member (assoc 10 el_l) el_l)))) c (mapcar '(lambda (x) (cons 10 (list (car x) (cadr x)))) lst_pt) ) (and (= 1 (logand 1 (cdr (assoc 70 el_l)))) (setq l2 (append l2 (list (assoc 10 el_l))))) (foreach p l2 (if (vl-some '(lambda (x) (equal p x dfzz)) c) (progn (setq r (cons p r)) (entmake (append l1 (reverse r) (if xd_l (list xd_l) '()))) (setq nwent (entlast) r (list p) c (vl-remove p c) ) (cond (lst_data (mapcar '(lambda (x / ct) (while (< (ade_odrecordqty nwent (caar x)) (ade_odrecordqty ent (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 r (cons p r)) ) ) (entmake (append l1 (reverse r) (if xd_l (list xd_l) '()))) (setq nwent (entlast)) (cond (lst_data (mapcar '(lambda (x / ct) (while (< (ade_odrecordqty nwent (caar x)) (ade_odrecordqty ent (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 ) ) ) (entdel ent) ) ) ) (print (sslength js)) (princ " LWpolyligne(s) coupée(s) aux points avec ses Object Datas.") ) ) (prin1) )

Modifier l'alti des sommets est possible. Cependant il faut se méfier de certaines commandes d'édition tel que: COUPURE, AJUSTER par exemple. En fait de toutes commande d'édition qui est susceptible de créer une seconde entité, car à ce moment là, la seconde entité (ou les deux) va perdre les OD. J'ai édité le post du code, car j'ai rajouté la récupération de certaines propriétés (couleur, type de ligne, échelle type de ligne, épaisseur de ligne)

Bonjour, Suite à une demande sur le forum US d'Autodesk, j'ai trouvé l'idée intéressante mais la routine proposée imparfaite à mon goût. J'ai donc décidé de l'améliorer... Elle permet de transformer une LWPOLYLINE en une 3DPOLYLINE. Si cette polyligne légère possède: - Une élévation, celle ci devient le Z des points de la 3Dpoly. - Des OD (Données d'Objets) ceux-ci sont transférer: il peut y avoir plusieurs tables ainsi que plusieurs enregistrements de données d'un même champ. - Des XData qui seront transférer à la nouvelle 3Dpoly (Donc avec un Autocad Classique la fonction fera le job mais ignorera les OD) Le calque est aussi conservé, les arcs de la polyligne légère (si présent) seront discrétiser (par angle de 1/36 de pi/2) Si la sélection de polylignes légères est importante avec beaucoup de données d'objet, le traitement peut être un peu long. Soyez patient ...! 😉 lwto3dpoly.lsp lwto3dpoly.lsp