bonuscad

Bonjour, Avant d'aller plus loin, as tu connaissance de la commande NCOPY des ExpressTools, car elle peut répondre à ton souhait. Pour info : (C:NCOPY) peut être inserer dans un lisp pour appeler cette fonction et continuer d'autres actions

Ou encore comme ceci (defun c:DHTest ( / Ent Obj Text) (while (setq Ent (nentsel "\nSélectionnez le texte dans le bloc :")) (setq Obj (entget (car Ent))) (if (/= (setq Text (cdr (assoc 1 Obj))) "") (princ Text) ) ) ;_ Fin de while (princ) ) Boucler simplement sur une sélection effective.

Bonjour, Et une expression diesel dans un bouton ne serait pas plus simple et aussi efficace? ^P$M=$(if,$(=,$(getvar,OSNAPZ),0),'OSNAPZ;1;,'OSNAPZ;0;)^Z

Je suis sous MAP2014 et je vois pas... La fonction (vl-load-com) a bien été lancé, car la ligne juste après "Largeur des cellules: " est: (setq tmp_file (vl-filename-mktemp "metre.dcl")) pour écrire le dcl de la boite de dialogue. D'ailleurs que retourne cette ligne si tu la copie-colle directement en ligne de commande? Edit: j'ai copier-coller le code donné en lien et effectivement des bbcode foutent le bordel (ça date de 2009) . Le plus simple je reposte le code de puis le fichier de mon PC (vl-load-com) (defun c:Length2Cell&Field ( / js AcDoc Space all_path end_pos id_path fonts_path file_shx nw_style oldim oldlay ins_pt_cell h_t w_c ename_cell n_row n_column n ename tmp_file dcl_file Id_obj q_lay q_col q_ltyp q_weig n_column lst_idcolumn do_it dcl_id nb_c) (or (setq js (ssget "_I")) (setq js (ssget "_P")) ) (cond (js (sssetfirst nil js) (initget "Existant Nouveau _Existent New") (if (eq (getkword "\nTraiter jeu de sélection [Existant/Nouveau] <Existant>: ") "New") (progn (sssetfirst nil nil) (setq js (ssadd) js (ssget))) ) ) (T (setq js (ssget))) ) (cond (js (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (cond ((null (tblsearch "LAYER" "Tableaux-Métrés")) (vla-add (vla-get-layers AcDoc) "Tableaux-Métrés") ) ) (cond ((null (tblsearch "STYLE" "Texte-Métré")) (setq all_path (getenv "ACAD") j 0) (while (setq end_pos (vl-string-position (ascii ";") all_path)) (setq id_path (substr all_path 1 end_pos)) (if (wcmatch (strcase id_path) "*FONTS*") (setq fonts_path (strcat id_path "\\")) ) (setq all_path (substr all_path (+ 2 end_pos))) ) (setq file_shx (getfiled "Selectionnez un fichier de police" fonts_path "shx" 8)) (if (not file_shx) (setq file_shx "txt.shx") ) (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Texte-Métré")) (mapcar '(lambda (pr val) (vlax-put nw_style pr val) ) (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag) (list file_shx 0.0 (/ (* 15.0 pi) 180) 1.0 0.0) ) (command "_.ddunits" (while (not (zerop (getvar "cmdactive"))) (command pause) ) ) ) ) (setq oldim (getvar "dimzin") oldlay (getvar "clayer") ) (setvar "dimzin" 0) (setvar "clayer" "Tableaux-Métrés") (initget 9) (setq ins_pt_cell (getpoint "\nPoint d'insertion haut gauche du tableau: ")) (initget 6) (setq h_t (getdist ins_pt_cell (strcat "\nHauteur du texte <" (rtos (getvar "textsize")) ">: "))) (if (null h_t) (setq h_t (getvar "textsize")) (setvar "textsize" h_t)) (initget 7) (setq w_c (getdist ins_pt_cell "\nLargeur des cellules: ")) (setq tmp_file (vl-filename-mktemp "metre.dcl") dcl_file (open tmp_file "w") ) (write-line "Length2CellField : dialog { label = \"Choix des colonnes à inscrire\"; : column { : toggle { label = \"Identification des objets\"; mnemonic = \"I\"; key = \"Id_obj\"; } : toggle { label = \"caLque de l'objet\"; mnemonic = \"L\"; key = \"q_lay\"; } : toggle { label = \"Couleur de l'objet\"; mnemonic = \"C\"; key = \"q_col\"; } : toggle { label = \"Type de ligne de l'objet\"; mnemonic = \"T\"; key = \"q_ltyp\"; } : toggle { label = \"Epaisseur de ligne de l'objet\"; mnemonic = \"E\"; key = \"q_weig\"; } } ok_cancel_err; }" dcl_file ) (close dcl_file) (setq Id_obj "0" q_lay "1" q_col "0" q_ltyp "0" q_weig "0" n_column 1 lst_idcolumn '("Longueur") do_it '((strcat ">%)." typ_measure " \\f \"%lu6\">%"))) (setq dcl_id (load_dialog tmp_file)) (setq what_next 2) (while (< 1 what_next) (if (not (new_dialog "Length2CellField" dcl_id)) (exit)) (set_tile "Id_obj" Id_obj) (set_tile "q_lay" q_lay) (set_tile "q_col" q_col) (set_tile "q_ltyp" q_ltyp) (set_tile "q_weig" q_weig) (set_tile "error" "") (action_tile "Id_obj" "(setq Id_obj $value)") (action_tile "q_lay" "(setq q_lay $value)") (action_tile "q_col" "(setq q_col $value)") (action_tile "q_ltyp" "(setq q_ltyp $value)") (action_tile "q_weig" "(setq q_weig $value)") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq what_next (start_dialog)) ) (unload_dialog dcl_id) (vl-file-delete tmp_file) (foreach z '(q_weig q_ltyp q_col q_lay Id_obj) (if (not (zerop (atoi (eval Z)))) (setq n_column (1+ n_column) lst_idcolumn (cons (cond ((eq z 'ID_OBJ) "ID Objet") ((eq z 'Q_LAY) "Calque") ((eq z 'Q_COL) "Couleur") ((eq z 'Q_LTYP) "Type Ligne") ((eq z 'Q_WEIG) "Epaisseur Ligne") ) lst_idcolumn ) do_it (cons (cond ((eq z 'ID_OBJ) ">%).ObjectName \\f \"%tc4\">%") ((eq z 'Q_LAY) ">%).Layer \\f \"%tc4\">%") ((eq z 'Q_COL) ">%).TrueColor \\f \"%tc4\">%") ((eq z 'Q_LTYP) ">%).Linetype \\f \"%tc4\">%") ((eq z 'Q_WEIG) ">%).Lineweight \\f \"%.2f mm%lw1\">%") ) do_it ) ) ) ) (setq ename_cell (vla-addTable Space (vlax-3d-point ins_pt_cell) (+ 3 (sslength js)) n_column (+ h_t (* h_t 0.25)) w_c)) (setq n_row 2 n_column -1) (vla-SetText ename_cell 0 0 "Tableau Récapitulatif de Métré") (vla-SetCellTextStyle ename_cell 0 0 "Texte-Métré") (vla-SetCellTextHeight ename_cell 0 0 (vlax-make-variant h_t 5)) (vla-SetCellAlignment ename_cell 0 0 5) (foreach string lst_idcolumn (vla-SetText ename_cell 1 (setq n_column (1+ n_column)) string) (vla-SetCellTextStyle ename_cell 1 n_column "Texte-Métré") (vla-SetCellTextHeight ename_cell 1 n_column (vlax-make-variant h_t 5)) (vla-SetCellAlignment ename_cell 1 n_column 5) ) (setq n_column -1) (repeat (setq n (sslength js)) (setq ename (vlax-ename->vla-object (ssname js (setq n (1- n))))) (foreach typ_measure '("Length" "ArcLength" "Circumference") (if (vlax-property-available-p ename (read typ_measure)) (progn (foreach el do_it (vla-SetText ename_cell n_row (setq n_column (1+ n_column)) (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID ename)) (eval el)) ) (vla-SetCellTextStyle ename_cell n_row n_column "Texte-Métré") (vla-SetCellTextHeight ename_cell n_row n_column (vlax-make-variant h_t 5)) (vla-SetCellAlignment ename_cell n_row n_column 6) ) (setq n_row (1+ n_row) n_column -1) ) ) ) ) (setq n_column (1- (length lst_idcolumn))) (cond ((zerop n_column) (setq nb_c "A")) ((eq n_column 1) (setq nb_c "B")) ((eq n_column 2) (setq nb_c "C")) ((eq n_column 3) (setq nb_c "D")) ((eq n_column 4) (setq nb_c "E")) ((eq n_column 5) (setq nb_c "F")) ) (vla-SetText ename_cell n_row n_column (strcat "Total= " "%<\\AcExpr (Sum(" nb_c "3:" nb_c (itoa n_row) ")) \\f \"%lu6\">%") ) (vla-SetCellTextStyle ename_cell n_row (1- (length lst_idcolumn)) "Texte-Métré") (vla-SetCellTextHeight ename_cell n_row (1- (length lst_idcolumn)) (vlax-make-variant h_t 5)) (vla-SetCellAlignment ename_cell n_row (1- (length lst_idcolumn)) 6) (vlax-release-object ename_cell) (vlax-release-object Space) (setvar "dimzin" oldim) (setvar "clayer" oldlay) ) (T (princ "\nSélection vide!") ) ) (prin1) )

Bonjour, As tu trouvé celui-là, et la tu essayé?

Comme le souligne (gile) l'extraction des code entre une (0 . "POLYLINE") et une (0 . "LWPOLYLINE") en DXF par (assoc) n'est pas identique. Pour s'affranchir de cette contrainte, on peut se tourner vers les fonctions (vlax-curve_get...) Cela donne un code plus générique qui fonctionnera quelque soit la polyligne 2D (splinée ou ajustée), 3D ou polyligne légère. (vl-load-com) (defun c:listpt_po ( / js AcDoc Space lst_pt n ename obj pr) (princ "\nSélectionner la polyline.") (while (null (setq js (ssget "_+.:E:S" (list (cons 0 "*POLYLINE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) (cons -4 "<NOT") (cons -4 "&") (cons 70 112) (cons -4 "NOT>") ) ) ) ) (princ "\nSélection vide, ou ce n'est pas une polyligne valable!") ) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (setq lst_pt nil ename (ssname js 0) obj (vlax-ename->vla-object ename) pr -1 ) (repeat (fix (vlax-curve-getEndParam obj)) (setq pr (1+ pr) lst_pt (cons (vlax-curve-GetPointAtParam obj pr) lst_pt) ) ) (setq lst_pt (cons (vlax-curve-GetPointAtParam obj (1+ pr)) lst_pt)) )

Salut, Ecris un MTEXT simple sans aucune option et fait (cdr (assoc 1 (entget (car (entsel))))) sur celui-ci, il va te retourné par exemple: "DenisHen" Edite ton mtext pour lui appliquer par exemple le soulignement et relance la ligne de code, tu auras comme retour: "{\\LDenisHen}" et ainsi de suite pour tout les effets qui t’intéresse. Par déduction tu devrais retrouver les codes à appliquer pour les effets souhaités. Remarque que bien la mise en accolade, fait attention aux textes dont le nombre de caractères est > 250, ça se reporte sur le code 3 autant de fois fois que nécessaire par pavés de 250 caractères. Donc c'est faisable, mais pas forcément aisé. Rappel: Tu as le code de StripMtext sur le net pour supprimer les effets et tu verra que le code n'est pas simple.

Une piste ? Si tu travaille en réseau avec des fichiers DWG ou fichiers de personnalisation partagés. Des ouvertures si lentes peuvent venir de là, il passe son temps à chercher un fichier qui n'est plus à disposition, soit que l'emplacement a changé soit des droits du dossier ont été modifiés. Si tu peux lancer ton Autocad en mode administrateur, tu as les même problèmes? Difficile de t'aider sans connaitre plus de détails de ton environnement...

Bonjour, Je pense que tu sera obligé de retoucher le code suivant. Au départ; il était conçu pour faire des hachures individuelles en ANSI31 en orientant le motif sur le plus grand coté de la polyligne, ceci pour toute les polylignes fermées sélectionnées. J'ai donc juste rajouté la couleur à transmettre à la hachure. (defun c:multi_hatch-45 ( / js n model_hatch scale_hatch ang_hatch ent dxf_ent col lst_pt lst_d where alpha dxf_hatch) (setq js (ssget '((0 . "LWPOLYLINE") (-4 . "<AND") (-4 . "&") (70 . 1) (-4 . "AND>")))) (cond (js (setq n -1 model_hatch (getvar "HPNAME") scale_hatch (getvar "HPSCALE") ang_hatch (getvar "HPANG") ) (setvar "HPNAME" "ANSI31") (setvar "HPSCALE" (* (getvar "HPSCALE") (getvar "DIMSCALE"))) (repeat (sslength js) (setq ent (ssname js (setq n (1+ n))) dxf_ent (entget ent) col (if (assoc 62 dxf_ent) (cdr (assoc 62 dxf_ent)) 256) lst_pt (mapcar '(lambda (x) (trans x ent 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent))) lst_d (mapcar 'distance lst_pt (cons (last lst_pt) lst_pt)) where (- (length lst_pt) (length (member (apply 'max lst_d) lst_d))) alpha (angle (if (zerop where) (last lst_pt) (nth (1- where) lst_pt)) (nth where lst_pt)) ) (setvar "HPANG" (angle (trans '(0 0 0) 0 1) (trans (polar '(0 0 0) alpha scale_hatch) 0 1))) (command "_.HATCH" "" "" "" ent "") (if (assoc 62 (setq dxf_hatch (entget (entlast)))) (entmod (subst (cons 62 col) (assoc 62 dxf_hatch) dxf_hatch)) (entmod (append dxf_hatch (list (cons 62 col)))) ) ) (setvar "HPNAME" model_hatch) (setvar "HPSCALE" scale_hatch) (setvar "HPANG" ang_hatch) ) (T (princ "\nAucune LWPOLYLINE fermée trouvé !")) ) (princ) )

A tout fin utile sur les paraboles, un truc que j'ai pompé sur un forum US je crois, donc merci à l'auteur. Si ça peut correspondre à ta demande? (defun C:PARABOLE ( / bod1 bod2 e l f x y i nd xp yp bod bodm) (initget (+ 1 16)) (setq bod1 (getpoint "\nPoint de départ: ")) (initget (+ 1 16)) (setq bod2 (getpoint bod1 "\nPoint final: ")) (setq xp (car bod1)) (setq yp (car (cdr bod1))) (setq l (- (car bod2) xp)) (princ "\nLargeur ordinale de la parabole: ") (princ l) (princ "\n") (setq e (- (car (cdr bod2)) yp)) (princ "\nHauteur ordinale de la parabole: ") (princ e) (princ "\n") (if (= l 0) (princ "\nErreur: ordonnées X équivalentes ") (progn (initget (+ 1)) (setq f (getdist "\nLongueur ordinale de la flèche: ")) (initget (+ 1 2 4)) (setq nd (getint "Nombre de segments: ")) (setq i 1) (repeat (1+ nd) (setq x (* (1- i) (/ l 1.0 nd))) (setq y (- (/ (* 4 f x x) 1.0 (* l l)) (* (- (/ (* 4 f) 1.0 l) (/ e 1.0 l)) x))) (setq bod (list (+ xp x) (+ yp y))) (if (= i 1) (progn (command "_.PLINE" "_none" bod)) (progn (command "_none" bod)) ) (setq bodm bod) (setq i (1+ i)) ) (command "") ) ) (princ) )

Heu merci, mais il m'arrive de me planter aussi, j'suis pas infaillible... Olivier a bien donné une bonne réponse en disant qu'il fallait voir la table des blocs (et non pas des insertions) donc effectivement: (assoc 70 (tblsearch "block" (cdr (assoc 2 (entget(car(entsel))))))) Retournera les bits du type de bloc comme ici Je me suis fourvoyé avec les block_record évoqué dans les tables -> ici Quand aux APPID je pense qu'ils servent à Autodesk (Acad, Map, Covadis) pour gérer plus facilement des états, à moins de savoir comment ils ont été constitué, pour l'utilisateur il me semble inutile de s'y penché dessus. Tiens amuse toi a lancer: ((lambda ( / flag rtn) (setq flag T) (while (setq rtn (tblnext "APPID" flag)) (print rtn) (setq flag nil) ) )) Ça risque rien, mais le retour va causer.

Didier, j'ai été aussi surpris que toi! D'après l'aide DXF 2018 le bit des xrefs est dans le code 70 des APPID ??? Alors que le code 70 de la table des blocs est devenue les unités d'insertion (0=sans unité) Confusion avec la table des BLOCK_RECORD qui affiche le code 70 avec les unités d'insertions. Pour DenisHen, avec le vla tu peux obtenir facilement ce que tu désire (vlax-for i (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-Acad-Object))) (if (= (vla-get-IsXref i) :vlax-true) (print (vla-get-name i)) ) )

Le très bon site en Anglais AfraLISP va avoir enfin son équivalent en Français. DA-CODE Le site Anglais a failli disparaître à une époque, mais des personnes l'ont remis sur pied, trouvant dommage qu'une telle documentation soit perdue. Et bien je souhaite le même avenir à ce nouveau site Français, si il devient une référence en la matière, il va vivre très longtemps! et sans mauvaise pensée, peut être te survivre. En tout cas BRAVO pour ton travail, et pointilleux comme tous ici nous le savons, la documentation ne peut qu'être précise et bien exposée, un gage de succés. Merci pour tous les amis Francophones.

Une autre suggestion, utiliser ACCORECONSOLE.EXE (faire une recherche sur le site (gile) en a parlé) Accoreconsole ne supportant pas les fonction (vlax), il faut réajuster Dans par exemple un fichier test.bat, ceci: echo off :: Chemin de la console AutoCAD (à modifier suivant la version utilisée) set accoreexe="C:\Program Files\Autodesk\Autodesk AutoCAD Map 3D 2014\accoreconsole.exe" :: Chemin du répertoire contentant les fichiers à traiter (à modifier) set source="C:\Users\XXX\Documents\XXX" :: Chemin du script à exécuter (à modifier) set script="C:\Users\XXX\Documents\XXX\test.scr" FOR /f "delims=" %%f IN ('dir /b "%source%\*.dwg"') DO %accoreexe% /i "%source%\%%f" /s %script% :: Mettre en commentaire pour fermer automatiquement la console à la fin du traitement pause et un fichier test.scr, avec ceci: ((lambda ( / js n ent lay l_coor tmp drawing f_open) (setq js (ssget "_X" '((0 . "LWPOLYLINE") (410 . "Model")))) (cond (js (repeat (setq n (sslength js)) (setq ent (ssname js (setq n (1- n))) lay (cdr (assoc 8 (entget ent))) l_coor (apply 'append (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))) tmp "C:/Users/XXX/Documents/XXX/tmp.csv" drawing (getvar "DWGNAME") f_open (open tmp "a") ) (write-line (strcat drawing ";" lay ";" (apply 'strcat (mapcar '(lambda (x) (strcat (rtos x 2 3) ";")) l_coor))) f_open) (close f_open) ) ) ) )) Avantage: n'utilise pas l'interface graphique d'autocad, donc plus rapide, autocad n'a même pas besoin d'être lancé. A tester et à ajuster selon nécessité.

Désolé je ne vois pas trop ce qui peut coincer. A part me répéter... Il ne faudrait pas que par exemple: "C:\Users\XXX\Documents\XXX\XXX.XX.00002.dwg" soit déjà ouvert (par toi ou quelqu'un d'autre), car à ce moment là la commande _OPEN va demander une option supplémentaire d'ouverture (ouverture du fichier en lecture seule: oui/non) J'ai mis _CLOSE _yes, c'est peut être une erreur de ma part d'enregistrer les modifications. Mettre _CLOSE _no serait peut être plus approprié, surtout que le dessin n'a subit aucun modification. Mais je pense pas que ce soit la raison du problème. Par acquis de conscience, j'ai vérifié que cela fonctionne avec le calque inactif, gelé et verrouillé, mais pas de souci (ssget "_x") fonctionne: la sélection se fait. J'ai pas d'autre éléments à apporter. Testé sous une 2014, qu'elle version a tu? Je passe la main.

Tu peux tenter ce qui suit: Ouvrir un nouveau dessin vierge (tes fichier à traiter doivent êtres tous fermés) Tu copie-colle ce qui suit directement en ligne de commande ((lambda ( / prefix file_scr tmp_file) (setq prefix (strcat (vl-filename-directory (getfiled "Sélectionner un fichier dessin TEMOIN" "" "dwg" 16)) "\\") file_scr (open (strcat prefix "traiter_dossier.scr") "w") tmp_file (strcat (vl-list->string (subst 47 92 (vl-string->list prefix))) "tmp.csv") ) (foreach dwg (vl-directory-files prefix "*.dwg" 1) (write-line "_.open" file_scr) (write-line (strcat "\"" prefix dwg "\"") file_scr) ;; ;;debut partie personnalisable ;; (write-line "((lambda ( / js n lay l_coor tmp drawing f_open)" file_scr) (write-line "(setq js (ssget \"_X\" '((0 . \"LWPOLYLINE\") (8 . \"_JCD_Rsx_ERDF\") (410 . \"Model\"))))" file_scr) (write-line "(cond" file_scr) (write-line "(js" file_scr) (write-line "(repeat (setq n (sslength js))" file_scr) (write-line "(setq" file_scr) (write-line "lay (vlax-get (setq obj (vlax-ename->vla-object (ssname js (setq n (1- n))))) 'Layer)" file_scr) (write-line "l_coor (vlax-get obj 'Coordinates)" file_scr) (write-line (strcat "tmp \"" tmp_file "\"") file_scr) (write-line (strcat "drawing \"" dwg "\"") file_scr) (write-line "f_open (open tmp \"a\")" file_scr) (write-line ")" file_scr) (write-line "(write-line (strcat drawing \";\" lay \";\" (apply 'strcat (mapcar '(lambda (x) (strcat (rtos x 2 3) \";\")) l_coor))) f_open)" file_scr) (write-line "(close f_open)" file_scr) (write-line ")" file_scr) (write-line ")" file_scr) (write-line ")" file_scr) (write-line "))" file_scr) ;; ;;fin partie personnalisable ;; (write-line "_.close" file_scr) (write-line "_yes" file_scr) ) (close file_scr) (princ (strcat "\Vous pouvez lancer le SCRIPT :" prefix "traiter_dossier.scr")) (prin1) )) Une boite de dialogue d'ouverture de fichier va s'ouvrir, tu en sélectionne un au hasard dans ton dossier à traiter ATTENTION tous les DWG du dossier seront traités et pas seulement celui sélectionné. (s'il y a des intrus, les déplacer avant) A la fin du traitement tu auras une indication comme quoi tu peux exécuter le script. Donc toujours dans le dessin vierge tu vas exécuter la commande SCRIPT et sélectionner le fichier .scr créé. Le script va alors s’exécuter et ouvrir tous tes dessins un par un et placer les données voulues dans un fichier "tmp.csv" qui sera dans le même dossier que le script généré. A toi d'ouvrir ce fichier avec ce que tu désire (bloc-note, libre-office, excel) sachant que le séparateur de champs est le ";"

Oui, si on reste sur des tracés homogène (segment relativement régulier) et cohérent avec le décalage voulu. De souvenir, il me semble que si tu fourni une liste semblable à ce que retourne (entsel) au lieu d'un simple ename cela à une influence sur la commande _fillet. Donc en construisant une liste semblable avec un point d'extrémité de ta ligne et son ename tu devrait obtenir le résultat souhaité. La commande _fillet va se comporter alors comme une utilisation manuelle, c'est à dire que le point de sélection à son importance suivant de quelle extrémité il est le plus proche.

Vincent, j'ai essayé ton lisp sur des figures un peu complexe et sans vouloir te décevoir, ce n'est pas ça. Pour ma part j'ai essayé de résoudre les phénomènes de boucle qui se croisent dans les segments décalés, mais je crois que je vais laisser tomber (trop complexe à analyser). J'ai édité mon code précédent du 4 Octobre où j'ai corrigé les plantages ou bugs que j'ai pu observé lors de test plus poussés. Il peut en rester... Donc à recopier pour tester! En résumé la routine accepte de traiter des LWPOLYLIGNE et POLYLIGNE2D (non lissé ou spliné) qu'elles soient fermée ou ouverte et ce dans n'importe quel SCU avec des entité crées aussi dans des SCU particulier (même ceux non parallèle au SCG). Je n'ai pas pu rivaliser avec l'algorithme d'Autodesk qui matérialise les épaisseurs en supprimant les boucles croisées et les rebroussements des bords droit ou arrondi, je m'incline :(

Merci de vos felicitations, mais la routine bien que que pouvant être sastifaisante est loin d'être une Rools! Pour ma part j'ai déja observé dans certain cas, un effet papillon (d'un bord à l'autre) sur le dernier segment. Autre défaut; bien que censé fonctionner sur des entités dans des SCU particuliers, l'accroissement des segments peut être bizzare ou la routine se plante. Des effets papillons sur le même bord lors de sucession d'un arc et ligne avec un angle serré. (un algorithme a implanter..) Bref c'est loin d'être achevé! Si (gile) peut apporté des améliorations, ça sera volontier, car j'atteint mes limites d'analyse. Je me suis trouver confronter à un drôle de problème, cela concerne (atan (cadr deriv) (car deriv)), deriv étant le résultat de (vlax-curve-getFirstDeriv obj param) (angtos (atan (cadr deriv) (car deriv))) me retourne bien le bon angle, mais les valeurs négatives ou positive de (cadr deriv) et de (car deriv) m'ont bien gêner pour trouver l'orientement correct des tangentes aux sommets (j'avais des valeur à pi prés, gênant pour orienter comme il faut.) Ma surprise vient que si je manipule avec (angtos (atan)), je n'est plus de problème de signe, mais convertir pour faire des test de condition, ça devient lourd. Donc du coup je me suis rabattu sur un orientement vectoriel. Bref, complétement perdu le bonhomme! Donc si (gile) ou un autre, peuvent me pointer du doigt là où le mât blesse, c'est volontier... Le challenge continu. A nous tous, on en aura une plus grosse qu'AutoDesk! :(rires forts):

Comme je le pensais, ça a été un peu casse-tête... Je vous livre un 1er jus de ce que j'avais décris: avoir comme des largeurs dégressives mais avec des bords en "dur" (on peut s'y accrocher). Il y a certainement des bugs ou imperfections à améliorer, mais je pense que c'est un bon début. (vl-load-com) (defun q_dir (p1 p2 p3 / v1 v2 v_or) (setq v1 (mapcar '- p2 p1) v2 (mapcar '- p1 p3) v_or (apply '(lambda (x1 y1 z1 x2 y2 z2) (- (* x1 y2) (* y1 x2))) (append v1 v2) ) ) ) (defun c:Progressive_Offset ( / js AcDoc Space th_start th_end ent obj param_curve perim_curve nb_vtx lst_pt lst_pl1 lst_pl2 deriv-1 det-or n-1 p_start p_end deriv dir_tg bulg rad p_cen alpha alpha_inc nw_pt op1 op2 d tmp_pt1 tmp_pt2 nw_pl) (princ "\nSélectionner la polyligne: ") (while (not (setq js (ssget "_+.:E:S" '((0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 126) (-4 . "NOT>"))))) (princ "\nPas d'objets valable ou sélection vide!") ) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (vla-startundomark AcDoc) (setq ent (ssname js 0) obj (vlax-ename->vla-object ent) param_curve (vlax-curve-getEndParam obj) perim_curve (vlax-curve-getDistAtParam obj param_curve) nb_vtx -1 lst_pt nil lst_pl1 nil lst_pl2 nil deriv-1 nil det_or nil n-1 nil ) (initget 5) (setq th_start (getdist (trans (vlax-curve-getPointAtParam obj 0) 0 1) "\nDemi-Largeur de départ: ")) (initget 4) (setq th_end (getdist (trans (vlax-curve-getPointAtParam obj param_curve) 0 1) (strcat "\nDemi-Largeur de fin <" (rtos (* 0.5 (/ (/ th_start perim_curve) (/ (1+ (sqrt 5)) 2)))) ">: "))) (if (not th_end) (setq th_end (* 0.5 (/ (/ th_start perim_curve) (/ (1+ (sqrt 5)) 2))))) (repeat (1+ (fix param_curve)) (setq nb_vtx (1+ nb_vtx) p_start (vlax-curve-getPointAtParam obj nb_vtx) p_end (vlax-curve-getPointAtParam obj (1+ nb_vtx)) deriv (vlax-curve-getFirstDeriv obj nb_vtx) deriv-1 (if (not deriv-1) (if (and (zerop nb_vtx) (eq (vla-Get-Closed obj) ':vlax-true)) (vlax-curve-getFirstDeriv obj (fix param_curve)) deriv ) (if (and (eq nb_vtx (fix param_curve)) (eq (vla-Get-Closed obj) ':vlax-true)) (vlax-curve-getFirstDeriv obj 0) deriv-1 ) ) lst_pt (cons (list p_start (setq dir_tg (* 0.5 (+ (atan (cadr deriv) (car deriv)) (atan (cadr deriv-1) (car deriv-1)) ) ) ) (- (atan (cadr deriv) (car deriv)) dir_tg) (if (and (eq nb_vtx (fix param_curve)) (eq (vla-Get-Closed obj) ':vlax-true)) th_end (+ th_start (* (/ (- th_end th_start) perim_curve) (vlax-curve-getDistAtParam obj nb_vtx))) ) ) lst_pt ) deriv-1 deriv ) (cond ((and p_end (not (zerop (setq bulg (vla-GetBulge obj nb_vtx))))) (setq rad (/ (distance (trans p_start 0 ent) (trans p_end 0 ent)) (sin (* 2.0 (atan bulg))) 2.0) p_cen (trans (polar (trans p_start 0 ent) (+ (angle (trans p_start 0 ent) (trans p_end 0 ent)) (- (* 0.5 pi) (* 2.0 (atan bulg)))) rad ) ent 0 ) alpha (angle (trans p_cen 0 ent) (if (< bulg 0.0) (trans p_end 0 ent) (trans p_start 0 ent))) alpha_inc (angle (trans p_cen 0 ent) (trans p_start 0 ent)) ) (repeat (fix (/ (rem (- (+ (* 2.0 pi) (angle (trans p_cen 0 ent) (if (< bulg 0.0) (trans p_start 0 ent) (trans p_end 0 ent)))) alpha) (* 2.0 pi)) (/ pi (/ 100.0 pi)))) (setq alpha_inc (if (< bulg 0.0) (- alpha_inc (/ pi (/ 100.0 pi))) (+ alpha_inc (/ pi (/ 100.0 pi)))) nw_pt (trans (polar (trans p_cen 0 ent) alpha_inc (abs rad)) ent 0) deriv (vlax-curve-getFirstDeriv obj (vlax-curve-getParamAtPoint obj nw_pt)) lst_pt (cons (list nw_pt (atan (cadr deriv) (car deriv)) 0.0 (+ th_start (* (/ (- th_end th_start) perim_curve) (vlax-curve-getDistAtPoint obj nw_pt))) ) lst_pt ) deriv-1 deriv ) ) ) ) ) (setq det_or (q_dir (caar lst_pt) (caadr lst_pt) (trans (polar (caar lst_pt) (+ (cadar lst_pt) (* 0.5 pi)) (caddar lst_pt)) 0 ent)) op1 (if (> det_or 0.0) '+ '-) op2 (if (> det_or 0.0) '- '+) ) (foreach n lst_pt (setq d (/ (cadddr n) (cos (caddr n)))) (if n-1 (setq det_or (q_dir (car n) n-1 (polar (car n) (+ (cadr n) (* 0.5 pi)) d)) op1 (if (> det_or 0.0) '+ '-) op2 (if (> det_or 0.0) '- '+) tmp_pt1 (trans (polar (car n) ((eval op1) (cadr n) (* 0.5 pi)) d) 0 ent) tmp_pt2 (trans (polar (car n) ((eval op2) (cadr n) (* 0.5 pi)) d) 0 ent) lst_pl1 (cons tmp_pt1 lst_pl1) lst_pl2 (cons tmp_pt2 lst_pl2) n-1 (car n) ) (setq tmp_pt1 (trans (polar (car n) ((eval op1) (cadr n) (* 0.5 pi)) d) 0 ent) tmp_pt2 (trans (polar (car n) ((eval op2) (cadr n) (* 0.5 pi)) d) 0 ent) lst_pl1 (cons tmp_pt1 lst_pl1) lst_pl2 (cons tmp_pt2 lst_pl2) n-1 (car n) ) ) ) (setq nw_pl (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar 'list (mapcar 'car lst_pl1) (mapcar 'cadr lst_pl1))))) (if (eq (vla-Get-Closed obj) ':vlax-true) (vla-put-Closed nw_pl 1)) (vla-put-Normal nw_pl (vla-get-Normal obj)) (vla-put-Elevation nw_pl (vla-get-Elevation obj)) (setq nw_pl (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar 'list (mapcar 'car lst_pl2) (mapcar 'cadr lst_pl2))))) (if (eq (vla-Get-Closed obj) ':vlax-true) (vla-put-Closed nw_pl 1)) (vla-put-Normal nw_pl (vla-get-Normal obj)) (vla-put-Elevation nw_pl (vla-get-Elevation obj)) (vla-endundomark AcDoc) (prin1) )

Si j'ai compris le besoin! Peut être ceci ? Construit une 3Dpoly passant par les intersection d'une poly2D et les arrêtes d'une 3Dface. C'est sommaire et pas trop testé en profondeur. ((lambda ( ) (princ "\nChoisir la polyligne 2D") (setq js_lw (ssget "_+.:E:S" '((0 . "LWPOLYLINE")))) (cond (js_lw (setq dxf_lw (entget (ssname js_lw 0)) dxf_10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_lw)) all_pt nil ) (while (cdr dxf_10) (setq p1 (car dxf_10) p2 (cadr dxf_10) js (ssget "_F" (list p1 p2) '((0 . "3DFACE"))) p1 (trans p1 1 0) p2 (trans p2 1 0) p1 (list (car p1) (cadr p1)) p2 (list (car p2) (cadr p2)) n -1 lst_px nil ) (cond (js (repeat (sslength js) (setq dxf_ent (entget (ssname js (setq n (1+ n)))) lst_pt (list (cdr (assoc 10 dxf_ent)) (cdr (assoc 11 dxf_ent)) (cdr (assoc 12 dxf_ent)) (cdr (assoc 13 dxf_ent)) ) ) (if (equal (caddr lst_pt) (cadddr lst_pt)) (setq lst_pt (list (car lst_pt) (cadr lst_pt) (caddr lst_pt) (car lst_pt))) (setq lst_pt (append lst_pt (list (car lst_pt)))) ) (while (cdr lst_pt) (setq px (inters p1 p2 (car lst_pt) (cadr lst_pt) T)) (if px (progn (setq px (inters (list (car px) (cadr px) 0.0) (list (car px) (cadr px) 100.0) (car lst_pt) (cadr lst_pt) nil)) (if px (setq lst_px (cons px lst_px)) ) ) ) (setq lst_pt (cdr lst_pt)) ) ) (if lst_px (setq all_pt (append lst_px all_pt)) ) ) ) (setq dxf_10 (cdr dxf_10)) ) (cond (all_pt (command "_.3dpoly") (foreach el all_pt (command "_none" (trans el 0 1))) (command "") ) (T (princ "\nAucune 3DFACE trouvée!")) ) ) ) (prin1) ))

T'es pas dans l'air du trump, heu du temps! :(rires forts): http://www.humeurs.be/wp-content/uploads/2017/04/PAN20170421_TrumpKim-Couleur-1600-1024x570.jpg Blague à part, je vais de mon côté, essayer de faire un clone de algorithme d'autodesk sur les largeurs variables pour avoir les bords en "dur". C'est pas gagné car le chalenge risque d'être difficile. Peut être que je laisserai tomber... :(

En cas d'effacement (ou non), il faut passer par les dictionnaires. ((lambda ( / id ename_lst) (setq id (dictsearch (namedobjdict) "ACAD_IMAGE_DICT")) (cond (id (foreach n id (if (eq (car n) 350) (setq ename_lst (cons (cdr n) ename_lst)) ) ) (cond (ename_lst (foreach el ename_lst (print (cdr (assoc 1 (entget el)))) ) ) ) ) ) (prin1) ))

Bonjour, Comme ceci? ((lambda ( / js n) (setq js (ssget "_x" '((0 . "IMAGE")))) (cond (js (repeat (setq n (sslength js)) (print (cdr (assoc 1(entget (cdr (assoc 340 (entget (ssname js (setq n (1- n)))))))))) ) ) ) (prin1) ))

C'est sûr! mais cela complique alors les choses. Pour en revenir au code de zebulon, je trouve que sa 1ere solution était meilleurs que le pas de résolution introduit par la suite. Il n'y a qu'a voir le résultat avec les largeurs en mode arc avec REMPLIR inactif. On voit que la résolution c'est faite par la division d'arc et non par une résolution par longueur de segment. Cette dernière peut être excessive pour des arc avec grand rayon et insuffisante pour des arc à petit rayon. 1/36 de pi/2 semble être une bonne valeur par défaut au lieu d'en demander une à l'utilisateur. Exemple: ((lambda ( / p1 p2 ll pt_m px1 px2 key p3 px3 px4 pt_cen rad inc ang nm lst_pt pa1 pa2) (initget 9) (setq p1 (getpoint "\nFirst point: ")) (initget 9) (setq p2 (getpoint p1 "\nNext point: ")) (setq ll (list p1 p2) pt_m (mapcar '/ (list (apply '+ (mapcar 'car ll)) (apply '+ (mapcar 'cadr ll)) (apply '+ (mapcar 'caddr ll)) ) '(2.0 2.0 2.0) ) px1 (polar pt_m (+ (angle p1 p2) (* pi 0.5)) (distance p1 p2)) px2 (polar pt_m (- (angle p1 p2) (* pi 0.5)) (distance p1 p2)) ) (princ "\nLast point: ") (while (and (setq key (grread T 4 0)) (/= (car key) 3)) (cond ((eq (car key) 5) (redraw) (setq p3 (cadr key) ll (list p1 p3) pt_m (mapcar '/ (list (apply '+ (mapcar 'car ll)) (apply '+ (mapcar 'cadr ll)) (apply '+ (mapcar 'caddr ll)) ) '(2.0 2.0 2.0) ) px3 (polar pt_m (+ (angle p1 p3) (* pi 0.5)) (distance p1 p3)) px4 (polar pt_m (- (angle p1 p3) (* pi 0.5)) (distance p1 p3)) pt_cen (inters px1 px2 px3 px4 nil) ) (cond (pt_cen (setq rad (distance pt_cen p3) inc (angle pt_cen p1) ang (+ (* 2.0 pi) (angle pt_cen p3)) nm (fix (/ (rem (- ang inc) (* 2.0 pi)) (/ (* pi 2.0) 36.0))) lst_pt '() ) (if (zerop nm) (setq nm 1)) (repeat nm (setq pa1 (polar pt_cen inc rad) inc (+ inc (/ (* pi 2.0) 36.0)) pa2 (polar pt_cen inc rad) lst_pt (append lst_pt (list pa1 pa2)) ) ) (setq lst_pt (append lst_pt (list pa2 p3))) (grvecs lst_pt) ) ) ) ) ) (prin1) ))