lecrabe

Hello YES cette DLL de Olivier est Tip-Top ... Grand MERCI a @Olivier Eckmann ! On se demande d ou il a eu l idee de la developper ! Bon dimanche, Bye, lecrabe

Hello Vive les Petits Vieux ! La Sante, Bye, lecrabe

Hello @CT_Ko + @didier @Olivier Eckmann Voici une routine Lisp "brut de fonderie" sur les ODs de MAP qui fait le Job Routine "OD_Field1ToField2" qui te demande les Noms EXACTS de ta Table OD et de tes 2 Champs OD (Depart / Arrivee) ATTENTION : aucune gestion d erreur ! Ne sélectionner QUE des objets ayant la bonne table OD et les 2 bons champs OD !! MAIS cela devrait BIEN t aider !? SVP tu nous diras ... Merci, Bye, lecrabe PS: je ne suis pas du tout Programmeur Lisp/VLisp ... J ai simplement adapte une routine sur les ODs "proche" ! ;; ;; Routine: OD_Field1ToField2 by Patrice B. for AutoCAD MAP & CIVIL ;; ;; ATTENTION : select ONLY Entities with the RIGHT OD Table ! ;; (vl-load-com) (defun C:OD_Field1ToField2 ( / js n_pl ent dxf_ent Nouv_Contenu Contenu Table_OD Champ_OD1 Champ_OD2 ) (princ "\n------ ATTENTION : No Error Management ! ------ ") (setq Table_OD (getstring T "\nPlease EXACT Name for the OD Table : ")) (setq Champ_OD1 (getstring T "\nPlease EXACT Name for the Departure OD Field 1 : ")) (setq Champ_OD2 (getstring T "\nPlease EXACT Name for the Arrival OD Field 2 : ")) (setq js (ssget )) (cond (js (repeat (setq n_pl (sslength js)) (setq ent (ssname js (setq n_pl (1- n_pl)))) (setq dxf_ent (entget ent)) (progn ;;;;;;;; Recuperation du Contenu du champ "Champ_OD1" de "Table_OD" ;;;;;;;; ( setq Contenu ( ade_odgetfield ent Table_OD Champ_OD1 0 ) ) ( setq Nouv_Contenu Contenu ) ;;;;;;;; Affectation du Nouveau Contenu dans le champ "Champ_OD" de "Table_OD" ;;;;;;;; ( ade_odsetfield ent Table_OD Champ_OD2 0 Nouv_Contenu ) ) ) ) ) (princ) )

Hello J imagine que tu penses a ce Post par exemple : Mais nous "Les Vieux C..." sommes patients et gentils ! Belle Annee 2024, La Sante, Bye, lecrabe

Hello Je suis très gentil cet AM ! SVP le Update 2017.1.2 par dessus l Update ... Si le problème persiste, tu sélectionnes toutes les Polylignes et tu inverses la Propriété : génération de type de ligne ... Bye, lecrabe

Hello @metacilla +1 avec @didier SVP tu reponds a nos questions / demandes d Infos ! Ca ne serait pas plutot des Polylignes ?? MERCI, Bye, lecrabe

Hello 1) Si tu fais un REGEN, est ce que l affichage redevient normal ? 2) As tu le Update 2017.1.2 sur ton AutoCAD 2017 ? Bye, lecrabe

Hello @(gile) et @Vincent P. et @didier J admire votre "courage et tenacite" ... Bravo ... Je suis d accord avec vous ! Bye, lecrabe

Hello Quand on a un problème "mysterieux" avec un logiciel, la règle d or est : Reboot et on re-essaye ! Bonne semaine, Bye, lecrabe

Hello Je suis un vieux c.. car c "no comprendo" pour moi ! En plus "cracher / insulter" AutoCAD et Autodesk en permanence, ça m enerve grave ! Si tu n es pas content d AutoCAD, de son prix, de ses fonctionnalités et bien tu peux acheter MicroStation, ZWCad, etc Bon WE, Belle Annee 2024, La Sante, Bye, lecrabe

Hello Pas sur de comprendre !? Connais tu la commande ATTSYNC ? Bye, lecrabe

Hello OK Merci donc Draftsight n est pas "tres compatible" Lisp / VLisp AutoCAD ! Bye, lecrabe

Hello @treza88 SVP au fait as tu pu charger et executer le Lisp LSTATT sur ton Draftsight ?? Merci, Bye, lecrabe

Hello @Eric Une reponse MAGISTRALE de Eric ! Bye, lecrabe

Hello Pas sur de bien comprendre ton besoin !? Le Lisp/VLisp "LSTATT" ci-apres est de notre REGRETTE Grand Maitre Patrick_35 ! Peut etre te conviendra t-il ? Cette routine "defile" sur l ecran texte les Blocs selectionnes (Comptage) ou bien dans un fichier, et CE en fonction du nombre d attributs choisi (1-N) ... Mais je ne sais pas si elle va fonctionner sur ton Draftsight !? ... Tu nous diras ? Bye, lecrabe ;;;================================================================= ;;; ;;; LSTATT.LSP V4.40 ;;; ;;; Décompte des blocs ;;; ;;; Copyright (C) Patrick_35 ;;; ;;;================================================================= ;; ;; --- Interrogation Entite/Objet en Lisp --- ;; (entget (car (entsel)) '("*")) ;; (defun c:lstatt(/ choix doc i js ent fic fil lab lst mrc trc n nb nm nombl InputBox liste_att mrech rechercher_nom s sel tbl trier txt visibilite *errlst*) (defun *errlst* (msg) (or (member (strcase msg) '("FUNCTION CANCELLED" ""QUIT / EXIT ABORT"" "FONCTION ANNULEE" "QUITTER / SORTIR ABANDON")) (princ (strcat "\nErreur : " msg)) ) (setq *error* s) (princ) ) (defun visibilite(nom / bl ok vi) (and (setq bl (vla-item (vla-get-blocks doc) nom)) (setq vi (vl-some '(lambda (pair) (if (and (= 360 (car pair)) (= "BLOCKVISIBILITYPARAMETER" (cdr (assoc 0 (entget (cdr pair))))) ) (cdr pair) ) ) (dictsearch (vlax-vla-object->ename (vla-getextensiondictionary bl)) "ACAD_ENHANCEDBLOCK") ) ) (setq vi (entget vi)) (setq ok (cdr (assoc 301 vi))) ) ok ) (defun nombl(bl / nom vi) (if (vlax-property-available-p bl 'effectivename) (progn (setq nom (vla-get-effectivename bl)) (and (setq vi (visibilite nom)) (= (vla-get-propertyname (car (vlax-invoke bl 'getdynamicblockproperties))) vi) (setq nom (strcat nom ":" (vlax-get (car (vlax-invoke bl 'getdynamicblockproperties)) 'value))) ) nom ) (vla-get-name bl) ) ) (defun choix(/ bl js lst nom sel) (princ "\nSelectionnez le(s) Bloc(s) a Denombrer : ") (and (ssget (list (cons 0 "insert"))) (progn (vlax-for bl (setq sel (vla-get-activeselectionset doc)) (or (member (setq nom (nombl bl)) lst) (setq lst (cons nom lst)) ) (redraw (vlax-vla-object->ename bl) 4) ) (foreach nom lst (if js (setq js (strcat js "," nom)) (setq js nom) ) ) (vla-delete sel) ) ) js ) (defun InputBox (Titre js / ch dcl fil res tmp txt) (setq tmp (vl-filename-mktemp "lstatt" nil ".dcl") fil (open tmp "w") ) (foreach txt '( "lstatt : dialog {" " key = \"titre\";" " alignment = centered;" " is_cancel = true;" " allow_accept = true;" " width = 30;" " : boxed_column {" " label = \"Veuillez donner un Nom de Bloc ou * pour tous\";" " : row {" " : edit_box {key = \"filtre\";width = 45;}" " : button {key = \"choix\"; label = \">>\";}" " }" " spacer;" " }" " : boxed_column {" " label = \"Nombre d'Attributs a prendre en compte\"; " " : edit_box {key= \"att\";}" " spacer;" " }" " spacer;" " : toggle {key = \"fic\"; label = \"Ecrire les Resultats dans un fichier\";}" " : toggle {key = \"lab\"; label = \"Ajouter le Nom des Etiquettes dans les Resultats\";}" " spacer;" " ok_cancel;" "}" ) (write-line txt fil) ) (close fil) (setq dcl (load_dialog tmp)) (while (not (member res '(0 1))) (new_dialog "lstatt" dcl "") (set_tile "titre" titre) (set_tile "filtre" js) (set_tile "att" nb) (set_tile "fic" fic) (set_tile "lab" lab) (action_tile "filtre" "(setq js $value)") (action_tile "choix" "(done_dialog 2)") (action_tile "att" "(setq nb $value)") (action_tile "fic" "(setq fic $value)") (action_tile "lab" "(setq lab $value)") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq res (start_dialog)) (and (eq res 2) (setq ch (choix)) (setq js ch) ) ) (unload_dialog dcl) (vl-file-delete tmp) (if (member res '(1 2)) js "" ) ) (defun liste_att(att / n lst val) (if (< (atoi nb) (length att)) (progn (setq n 0) (while (and (< n (atoi nb)) (setq val (nth n att))) (setq lst (cons (if (eq lab "0") (vla-get-textstring (nth n att)) (strcat (vla-get-tagstring (nth n att)) ":" (vla-get-textstring (nth n att))) ) lst ) n (1+ n) ) ) (reverse lst) ) (if (eq lab "0") (mapcar 'vla-get-textstring att) (mapcar '(lambda(x)(strcat (vla-get-tagstring x) ":" (vla-get-textstring x))) att) ) ) ) (defun rechercher_nom(val / att nom tbl) (setq nom (nombl val)) (if (eq (vla-get-hasattributes val) :vlax-true) (if (member (setq att (vlax-invoke val 'getattributes)) '(nil)) (list nom) (cons nom (liste_att att)) ) (list nom) ) ) (defun trier(a b / c n s) (setq c 0) (while (and (not s) (nth c a)) (if (eq (nth c a) (nth c b)) (setq c (1+ c)) (setq s T) ) ) (or (nth c a) (setq c 0)) (< (strcase (nth c a)) (strcase (nth c b))) ) (defun mrech(bl / ent lst recu) (defun recu(bl) (vlax-for ent (vla-item (vla-get-blocks doc) (nombl bl)) (and (eq (vla-get-objectname ent) "AcDbBlockReference") (if (eq (substr (nombl ent) 1 1) "*") (recu ent) (setq lst (cons ent lst)) ) ) ) ) (and (eq (substr (nombl bl) 1 1) "*") (recu bl) ) lst ) (vl-load-com) (setq s *error* *error* *errlst* doc (vla-get-activedocument (vlax-get-acad-object)) ) (or (setq nb (getenv "Patrick_35_nb_att")) (setq nb "1") ) (or (setq lab (getenv "Patrick_35_nb_lab")) (setq lab "0") ) (setq fic "0") (if (not (eq (setq nm (InputBox "Decompte de Blocs v4.40" "*")) "")) (progn (setq js (strcat "`**," nm)) (if (ssget (list (cons 0 "INSERT") (cons 2 js))) (progn (setenv "Patrick_35_nb_att" nb) (setenv "Patrick_35_nb_lab" lab) (vlax-map-collection (setq sel (vla-get-activeselectionset doc)) '(lambda (x) (if (setq trc (mrech x)) (foreach mrc trc (if (wcmatch (strcase (car (setq js (rechercher_nom mrc)))) (strcase nm)) (setq tbl (cons js tbl)) ) ) (if (wcmatch (strcase (car (setq js (rechercher_nom x)))) (strcase nm)) (if (eq (vla-get-objectname x) "AcDbMInsertBlock") (repeat (* (vla-get-columns x) (vla-get-rows x)) (setq tbl (cons js tbl)) ) (setq tbl (cons js tbl)) ) ) ) ) ) (vla-delete sel) (while tbl (setq n (length tbl) js (car tbl) tbl (vl-remove js tbl) lst (cons (cons (itoa (- n (length tbl))) js) lst) ) ) (if lst (progn (and (eq fic "1") (setq fil (open (setq txt (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".txt")) "w")) ) (foreach n (vl-sort lst '(lambda (a b) (trier (cdr a) (cdr b)))) (if (eq fic "1") (princ (strcat (car n) (chr 9) (cadr n)) fil) (princ (strcat "\n" (substr " " 1 (- 5 (strlen (car n)))) (car n) " " (cadr n) ) ) ) (setq i 2) (while (setq val (nth i n)) (if (eq fic "1") (princ (strcat (chr 9) val) fil) (princ (strcat "..." val)) ) (setq i (1+ i)) ) (and (eq fic "1") (write-line "" fil) ) ) (and (eq fic "1") (princ (strcat "\nFichier \"" txt "\" cree. ")) (close fil) ) ) (princ "\nPas de bloc a Denombrer ! ") ) ) ) ) ) (setq *error* s) (princ) ) (setq nom_lisp "LSTATT") (if (/= app nil) (if (= (strcase (substr app (1+ (- (strlen app) (strlen nom_lisp))) (strlen nom_lisp))) nom_lisp) (princ (strcat "..." nom_lisp " charge. ")) (princ (strcat "\n" nom_lisp ".LSP Charge ... Tapez " nom_lisp " pour l'executer."))) (princ (strcat "\n" nom_lisp ".LSP Charge ... Tapez " nom_lisp " pour l'executer."))) (setq nom_lisp nil) (princ)

Hello ZUT ! Bye, lecrabe

Hello @Olivier Eckmann Modifier la routine BUFFER de Kent Cooper pour avoir une Droite et non pas un Arc 180 degres, me parait simple ?! Comme en sortie de BUFFER, tu obtiens N Polylignes 2D closes, tu pourrais les utiliser pour sélectionner les Blocs !? Mais Bon, je ne suis pas (plus en fait) développeur depuis environ 25 ans ! Good luck, Bye, lecrabe

Hello @Olivier Eckmann & @didier Alors j utilise parfois l excellente routine BUFFER (de Kent Cooper) qui dessine de magnifiques Buffers autour de N Polylignes 2D (meme avec des Arcs ou "Courbees" mais NON "Splinees") et qq autres entites ... Et apres j utilise les routines SSOC & SSOF de Gilles suivant mes besoins ... BUFFER t aidera peut etre !? Belle annee 2024, La Sante, Bye, lecrabe PS: en provenance de mon stock de 3001 routines ... ;; ;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/buffer-lisp-code-around-pline/td-p/5489225 ;; ;| BUFFER.lsp [command name: BUFFER] To put a "buffer" boundary outline of User-specified width around User- selected Offsettable object(s). Offsets selected object(s) by specified distance, on both sides of open-ended objects, or for closed objects, User choice of both sides or outboard only [e.g. wetlands perimeter would not need inboard buffer edge]. Outboard-only would be equivalent to regular Offset, except BUFFER determines which way is outboard without need for User designation, always rounds convex corners of resulting Polylines, and remembers buffer width. If object is open-ended [other than Xline], Offsets to both sides & wraps Arc(s) around end(s) [for Ray, only one end], connecting ends of offset elements to complete boundary. If object is a Line, Arc or non-Fit/Splined Polyline, joins buffer boundary into one enclosing Polyline. Option for resulting buffer boundary to be on same Layer as Source object or on Current Layer. Buffer width & Layer choices independent of regular Offset's distance/Layer options, and are remembered and offered as default on subsequent use. Under Both-ways option for closed objects, if Circle radius or closed Ellipse minor radius is not greater than buffer width, goes outboard only. If Arc or partial Ellipse radius is not greater than buffer width, does not go inboard, but still wraps arcs around ends and if appropriate, trims to close. Can fail or have unexpected results if Polyline/Spline has certain conditions, e.g. self-intersection, or [relative to buffer width] too-tight curvature or too- close interior approach or too-short end segment(s), or if Ellipse has minor radius too close to buffer width, because Offsetting can either fail or result in more than one object. Kent Cooper, last edited 5 January 2017 |; ;;;;; [doesn't yet work for open objects in different UCS, though for many ;;;;; objects it will look as though it did from current point of view] (defun C:BUFFER (/ *error* doc svnames svvals ss n ent edata closed new obj etype ang pton e1 e2) (defun *error* (errmsg) (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break")) (princ (strcat "\nError: " errmsg)) ); if (mapcar 'setvar svnames svvals); reset System Variables (vla-endundomark doc) (princ) ); defun - *error* (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark doc) (setq ; System Variable saving/resetting without separate variables for each: svnames '(osmode cmdecho peditaccept offsetgaptype blipmode offsetdist) svvals (mapcar 'getvar svnames) ); setq (mapcar 'setvar svnames '(1 1 0)); throughout-routine SV's (initget (if *bufferdist 0 1)); no Enter on first use (setq *bufferdist ; global variable (cond ( (getdist ; returns nil on Enter (strcat "\nBuffer width" (if *bufferdist (strcat " <" (rtos *bufferdist) ">") ""); prior-value default if present ": " ); strcat ); getdist ); User-input condition (*bufferdist); prior value [if present] on Enter ); cond & *bufferdist ); setq (initget "Current Source") (setq *bufferlay ; global variable (cond ( (getkword (strcat "\nLayer for buffer outlines [Current/Source] <" (cond (*bufferlay) ("Current")); prior value default if present ** ">: " ); strcat ); getkword ); User-input condition (*bufferlay); prior value if present on Enter ("Current"); initial-use default on Enter with no prior value ** ; ** if "Source" preferred as initial default, EDIT in two places above ); cond ); setq (prompt "\nTo add surrounding buffer outline(s),") (if (and (setq ss (ssget "_:L" '((0 . "*LINE,ARC,CIRCLE,ELLIPSE,RAY")))) ; *LINE allows Line/Polyline [any kind]/Spline/Xline/Mline, but Mlines & 3D ; Polylines/Splines can't be offset, and don't want Polygon/Polyface Meshes, so: (repeat (setq n (sslength ss)) (setq edata (entget (setq ent (ssname ss (setq n (1- n)))))) (if (or (member '(0 . "MLINE") edata) (and (member '(0 . "POLYLINE") edata); "heavy" type (/= (logand 88 (cdr (assoc 70 edata))) 0); 8 = 3DPoly, 16 or 64 = mesh ); and (not (vlax-curve-isPlanar ent)); 3D Spline ); or (ssdel ent ss); then -- remove [returns reduced ss] (if (vlax-curve-isClosed ent); else -- for Circle, closed Pline/Ellipse/Spline (setq closed T); then -- marker for both-ways question later T ; else [for non-nil return from (repeat) if last object is open] ); if [else] ); if ); repeat (> (sslength ss) 0); valid object(s) remaining ); and (progn ; then -- proceed (mapcar 'setvar svnames (list 0 0 1 1 0 *bufferdist)); set System Variables (if closed ; any remaining viable object(s) closed? (progn (initget "Both Outboard") (setq *buffersides ; global variable (cond ( (getkword (strcat "\nFor closed object, offset Both ways or Outboard only? [Both/Outboard] <" (cond (*buffersides) ("Outboard")); prior value default if present ** ">: " ); strcat ); getkword ); User-input condition (*buffersides); prior value if present on Enter ("Outboard"); initial-use default on Enter with no prior value ** ; ** if "Both" preferred as initial default, EDIT in two places above ); cond ); setq ); progn ); if (repeat (setq n (sslength ss)) (setq new (ssadd); initially empty for each obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))) etype (substr (vla-get-ObjectName obj) 5); without AcDb prefix closed (vlax-curve-isClosed obj); [re-use variable name] ); setq (if (= etype "Ray") (progn ; then [by pick because (vla-offset) method not available] (setq ang (angle (vlax-get obj 'BasePoint) (setq pton (vlax-get obj 'SecondPoint)) ; [less subject to seeing something else than end] ); angle pickoffs (list (getvar 'aperture) (getvar 'aperture)) ); setq (while ; find pick location where Offset pick finds only this Ray (> (sslength (ssget "_C" (mapcar '+ pton pickoffs) (mapcar '- pton pickoffs))) 1) ; more than one thing within Osnap Aperture range? (setq pton (polar pton ang 1)); then -- move along Ray ); while (command "_.offset" "" pton (polar pton (- ang (/ pi 2)) *bufferdist) "") (setq e1 (entlast)) (ssadd e1 new) (command "_.offset" "" pton (polar pton (+ ang (/ pi 2)) *bufferdist) "") (setq e2 (entlast)) (ssadd e2 new) ); progn -- then (progn ; else [all other types] (vla-offset obj *bufferdist); always outboard of Arc/Circle/Ellipse (setq e1 (entlast)) (if (and closed (= *buffersides "Outboard") (< (vla-get-Area (vlax-ename->vla-object e1)) (vla-get-Area obj)); went inboard ); and (entdel e1); then -- remove [other-way Offset wanted] (ssadd e1 new); else ); if (if ; Offset other way when applicable: (cond ((wcmatch etype "Line,Xline")) ((= etype "Arc") (> (vlax-get obj 'Radius) *bufferdist)); big enough ((= etype "Circle") (and (> (vlax-get obj 'Radius) *bufferdist); big enough (= *buffersides "Both"); if asked for [always closed] ); and ); Circle condition ((= etype "Ellipse") (and (> (vlax-get obj 'MinorRadius) *bufferdist); big enough (if closed (= *buffersides "Both") T) ); and ); Ellipse condition ((not closed)); open-ended Polyline/Spline ((= *buffersides "Both")); closed Polyline/Spline ((not (entget e1))); Outboard-only option with closed Polyline/Spline ; first one was inboard under Outboard-only option, so deleted ; [if (entget) succeeds, e1 was already outboard -- don't go other way] ); cond (progn ; second Offset (vla-offset obj (- *bufferdist)) (setq e2 (entlast)) (ssadd e2 new) ); progn ); if ); progn -- else [other than Ray] ); if [Ray or otherwise] (if (and (not closed) (/= etype "Xline")) ; open-ended object other than Xline -- wrap Arcs around ends (progn ; then (command "_.arc" (vlax-curve-getStartPoint e1) "_c" (vlax-curve-getStartPoint obj) ; [spelling out "_cen[ter]" is taken as Osnap call] "_angle" (strcat (if (= etype "Line") "" "-") (angtos pi (getvar 'aunits) 8); any Units angle settings ); strcat ); command (ssadd (entlast) new) (if (/= etype "Ray"); other end for all but Ray (progn ; then (command "_.arc" (vlax-curve-getEndPoint e1) "_c" (vlax-curve-getEndPoint obj) "_angle" (strcat (if (= etype "Line") "-" "") (angtos pi (getvar 'aunits) 8); any Units angle settings ); strcat ); command (ssadd (entlast) new) ); progn ); if [not Ray] (if (wcmatch etype "*Polyline,Line,Arc"); connectable with Pedit ; [In older versions, Fit-curved or Spline-curved 2D Polyline will LOSE curvature ; if PEDIT/Joined; if an issue, replace above (if... line with: ; (if ; (or ; (wcmatch etype "Line,Arc,Polyline"); always PEDIT/Joinable without loss ; (and ; (= etype "2dPolyline") ; (= (vlax-get obj 'Type) 0); NOT Fit- or Spline-curved ; ); and ; ); or ; In newer versions, could use JOIN also with Spline, Ellipse or such Plines, BUT: ; JOIN when in a (command) function does NOT allow multiple initial selection ; as command-line version does, but requires selecting one object first, after which ; expectations vary with combinations of entity types, etc., e.g. if Line selected first, ; can't JOIN Arc to it, or vice versa. If desired to use JOIN with other entity types ; than Lines/Arcs/"plain" Polylines joinable via PEDIT, do it manually afterwards. ; [As of Acad2016 -- may change in later versions.] (progn ; then (command "_.pedit" "_multiple" new "" "_join" "" ""); connect them (ssadd (entlast) new) ); progn ); if [Pedit-Joinable or not] (if (and (wcmatch etype "Arc,Ellipse") (not closed); if Ellipse, partial [i.e. not full with Outboard-only option] (not e2); did not go inboard [radius not more than buffer width] ); and (if (= etype "Arc"); then -- trim end-wrapping arcs if needed (if (not (vlax-curve-isClosed (setq e1 (entlast)))); [re-use variable name] ; with close-enough ends, PEDIT/Join sometimes trims to closed, but if not: (command "_.trim" e1 "" ; then (vlax-curve-getStartPoint e1) (vlax-curve-getEndPoint e1) "" ); command ); if [joined-Polyline result around Arc] (if ; else [open Ellipse -- buffer not joined] (vlax-invoke (setq e1 (vlax-ename->vla-object (ssname new 1))); [re-use variable names] ; 1st Arc [0 is outward-Offset Spline] 'IntersectWith ; Arcs cross? [won't always with Ellipses as with Arcs] (setq e2 (vlax-ename->vla-object (ssname new 2))); 2nd acExtendNone ); vlax-invoke (command "_.trim" new "" ; then (vlax-curve-getStartPoint e1) (vlax-curve-getEndPoint e2) ); command ); if ); if [Arc vs. Ellipse] ); if [may need wrap-around-end Arcs trimmed] ); progn -- then ); if [open-ended non-Xline or otherwise] (command "_.chprop" new "" "_layer" (if (= *bufferlay "Source") (vla-get-Layer obj) (getvar 'clayer)) "" ); command ); repeat [through selection set] ); progn -- then (prompt "\nNo Offsettable object(s) selected."); else ; [whether because of object type(s) or locked Layer(s)] ); if [valid selection or not] (mapcar 'setvar svnames svvals); reset (vla-endundomark doc) (princ) ); defun (vl-load-com) (prompt "\nType BUFFER to add buffer boundary outline(s) around object(s). ")

Hello Pas sur de bien comprendre !? MAPTRIM est une spécificité de AutoCAD MAP Cette commande n existe pas sur AutoCAD, AutoCAD LT, AutoCAD Archi, etc SVP on parle bien de AutoCAD MAP !? D autre part pour que MAPTRIM fonctionne, il faut avoir tous les Chemins/Paths nécessaires dans les chemins de support de AutoCAD MAP ! Merci, Bye, lecrabe

Hello @lili2006 Tu as 2 bonnes réponses ! Bye, lecrabe

Hello @DenisHen En résumé une somme de petites choses fait de grandes choses ! Bye, lecrabe

Hello SVP tu as quelle version exactement de Covadis sur AutoCAD / ACAD MAP ? Et quelle version de GeoGexFr sur ZWCAD ? @thierry.garré ? Belle annee 2024, La Sante, Bye, lecrabe

Hello @ZCAD SVP quel Lisp ?? MERCI, Bye, lecrabe

Hello @Sansan SVP peux tu nous dire quelles routines (parmi les 2) tu as testees ? Etaient elles OK avec ton AutoCAD LT 2024 ? Laquelle te convient le mieux ? Pourquoi ? MERCI, Bye, lecrabe

Hello @ZCAD Voici une routine "INSTOPO"du Grand Maitre Gilles qui insere au choix : -- un Bloc TCPOINT (avec 2 Attributs MAT & ALT) -- un Point -- ou les DEUX ( Si le Bloc TCPOINT n existe pas dans ton DWG, il sera cree "a la volee" ) depuis un fichier TXT, CSV, etc ... RAPPEL : Comme tu n as rien derriere tes Coords XY : MAT et ALT seront vides ... J ai teste sur ton fichier XY TXT, ca marche parfaitement ... Cela te convient il ?? Bye, lecrabe ;;; ;;; http://gile.pagesperso-orange.fr/LISP/InsTopo.lsp ;;; ;;; INSTOPO par GC / Gilles ;;; ;;; Insère le bloc "PointBloc" sur les points décrit dans un fichier ascii (.txt .csv ou autre) ;;; ;;; Modification : possibilité d'insérer un point 02/12/2009 ;;; (defun c:InsTopo (/ *error* makeblock filename tmp file layers clay ptlay blklay data-sep dec-sep mat-p mat alt scl point bloc dcl_id space line coords matric insert ) (vl-load-com) (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))) ) (or *blocks* (setq *blocks* (vla-get-Blocks *acdoc*))) ;;---------------------------------------------------;; (defun *error* (msg) (or (= msg "Fonction annulée") (princ (strcat "Erreur: " msg)) ) (and file (close file)) (vla-EndUndoMark *acdoc*) (princ) ) ;;---------------------------------------------------;; ;; MakeBlock ;; Crée le bloc PointBloc (defun makeblock (/ block) (vl-load-com) (setq block (vla-add *blocks* (vlax-3d-point '(0. 0. 0.)) "TCPOINT" ) ) (vla-put-Layer (vla-addPoint block (vlax-3d-point '(0. 0. 0.))) "0" ) (vla-put-Layer (vla-addAttribute block 2.5 acAttributeModePreset "" (vlax-3d-point '(1. 0.5 0.)) "MAT" "" ) "0" ) (vla-put-Layer (vla-addAttribute block 2.5 acAttributeModePreset "" (vlax-3d-point '(1. -3. 0.)) "ALT" "" ) "0" ) ) ;;---------------------------------------------------;; (if (setq filename (getfiled "Selectionner un fichier point " "" "txt;csv;*" 0 ) ) (progn ;; Création du fichier DCL temporaire (setq tmp (vl-filename-mktemp "Tmp.dcl") file (open tmp "w") ) (write-line "InsTopo :dialog{label=\"InsTopo\"; :boxed_row{label=\"Format du fichier\"; :boxed_radio_column{label=\"Separateur de donnees\";key=\"data-sep\"; :radio_button{label=\"Virgule\";key=\"44\";value =\"1\";} :radio_button{label=\"Point-virgule\";key =\"59\";} :radio_button{label=\"Espace\";key=\"32\";} :radio_button{label=\"Tabulation\";key =\"9\";}} :column{ :boxed_radio_column{label=\"Separateur décimal\";key=\"dec-sep\"; :radio_button{label=\"Virgule\";key =\"com\";} :radio_button{label=\"Point\";key=\"dot\";value=\"1\";}} :boxed_radio_column{label=\"Matricule\";key=\"mat-p\"; :radio_button{label=\"Present\";key=\"present\";value=\"1\";} :radio_button{label=\"Absent\";key=\"absent\";}}}} :boxed_column{label=\"Point\"; :row{ :toggle{label=\"Inserer des points\";key=\"point\";value=\"1\";} :popup_list{label=\"Calque\";key =\"ptlay\";edit_width = 24;}} spacer;} :boxed_column{label=\"Bloc\"; :toggle{label=\"Inserer de blocs\";key=\"bloc\";value=\"1\";} :row{ :boxed_column{label=\"Attributs\"; :toggle{label=\"Matricule\";key=\"mat\";value=\"1\";} :toggle{label=\"Altitude\";key=\"alt\";value=\"1\";}} spacer; :column{spacer; :popup_list{label=\"Calque\";key =\"blklay\";edit_width = 24;} :edit_box{label=\"Echelle \";key=\"scl\";value=\"1.0\";fixed_width=true;} spacer;}}} ok_cancel;}" file ) (close file) (vlax-for l (vla-get-Layers *acdoc*) (setq layers (cons (vla-get-Name l) layers)) ) (setq layers (vl-sort layers '<) clay (getvar "CLAYER") ptlay clay blklay clay data-sep "44" dec-sep "dot" mat-p "present" mat "1" alt "1" scl 1.0 point T bloc T ) (setq dcl_id (load_dialog tmp)) (if (not (new_dialog "InsTopo" dcl_id)) (exit) ) (start_list "ptlay") (mapcar 'add_list layers) (end_list) (start_list "blklay") (mapcar 'add_list layers) (end_list) (set_tile "ptlay" (itoa (vl-position clay layers))) (set_tile "blklay" (itoa (vl-position clay layers))) (foreach k (list "data-sep" "dec-sep" "mat-p" "mat" "alt") (action_tile k "(set (read $key) $value)") ) (action_tile "point" "(if (= \"1\" $value) (progn (setq point T) (mode_tile \"ptlay\" 0) ) (progn (setq point nil) (mode_tile \"ptlay\" 1) ) )" ) (action_tile "bloc" "(if (= \"1\" $value) (progn (setq bloc T) (mode_tile \"blklay\" 0) (mode_tile \"mat\" 0) (mode_tile \"alt\" 0) (mode_tile \"scl\" 0) ) (progn (setq bloc nil) (mode_tile \"blklay\" 1) (mode_tile \"mat\" 1) (mode_tile \"alt\" 1) (mode_tile \"scl\" 1) ) )" ) (action_tile "ptlay" "(setq ptlay (nth (atoi $value) layers))") (action_tile "blklay" "(setq blklay (nth (atoi $value) layers))") (action_tile "scl" "(setq scl (distof $value)) (while (or (not scl) (<= scl 0)) (alert \"Nécessite un nombre réel strictement positif\") (setq scl 1.0) (set_tile \"scl\" \"1.0\") (mode_tile \"scl\" 2))" ) (action_tile "cancel" "(setq data-sep nil) (done_dialog 0)") (action_tile "accept" "(done_dialog 1)") (start_dialog) (unload_dialog dcl_id) (vl-file-delete tmp) (if data-sep (progn (vla-StartUndoMark *acdoc*) (and (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list *blocks* "TCPOINT") ) ) (makeblock) ) (setq space (vla-get-ModelSpace *acdoc*) file (open filename "r") ) (while (setq line (read-line file)) (setq coords (str2lst line (chr (atoi data-sep)))) (if (= mat-p "present") (setq matric (car coords) coords (cdr coords) ) (setq matric nil) ) (if (= dec-sep "com") (setq coords (mapcar '(lambda (x) (read (vl-string-translate "," "." x)) ) coords ) ) (setq coords (mapcar 'read coords)) ) (setq coords (list (car coords) (cadr coords) (cond ((caddr coords)) (T 0.0) ) ) ) (if (vl-every 'numberp coords) (progn (if point (vla-put-Layer (vla-AddPoint space (vlax-3d-point coords)) ptlay ) ) (if bloc (progn (setq insert (vla-InsertBlock space (vlax-3d-point coords) "TCPOINT" scl scl scl 0.0 ) ) (vla-put-Layer insert blklay) (foreach att (vlax-invoke insert 'getAttributes) (if (and (= (vla-get-TagString att) "MAT") matric (= mat "1") ) (vla-put-TextString att matric) ) (if (and (= (vla-get-TagString att) "ALT") (= alt "1") ) (vla-put-TextString att (rtos (caddr coords))) ) ) ) ) ) ) ) (close file) (vla-EndUndoMark *acdoc*) ) ) ) ) (princ) ) ;; 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") ;; (mapcar 'read (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) ) )