bonuscad

Bonjour, (getvar "USERS1") sert à récupérer la valeur de la variable utilisateur "USERS1" (il y en a 5 en tout) Ici cela doit être une chaine de caractère: userS (S pour String) I pour Interger et R pour Real Pour que la ligne lisp fonctionne "USERS1" devrait contenir le nom d'un bloc existant dans le dessin (pas forcément inséré!). Par défaut cette variable ne contient rien ("") Donc si ce bloc de nom valide existe, (tblobjname) retournera le nom (entitie name) de la définition du bloc dans la table sous la forme: <Nom d'entité: 7ffffb54f10> Alors (entget) avec ce nom d'entité va te retourner la définition du bloc sous la forme comme expliqué ICI enfin (assoc x liste_entget) va te retourner la liste associé à la clé demandée NB: Je vois pas quelle peut être la clé 4 demandé dans ton code, la clé 2 par exemple retournerai le nom du bloc (2 . "Nom_du_Bloc") (cdr) retourne le second élément de la liste en paire pointée. (setvar "USERS1" "xxx") redéfini la variable avec la nouvelle chaine indiquée.

Autrement un résultat plus facile à mettre en œuvre, mais seulement visuel; on ne peut pas s'accrocher aux bords des représentations faites. Cela utilise simplement les largeurs de départ et fin d'une polyligne. (vl-load-com) (defun c:Effile_Poly ( / js th_start th_end n ent obj flag_close param_curve perim_curve nb_vtx w_end w_start) (princ "\nSélectionner les polylignes: ") (while (not (setq js (ssget '((0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 126) (-4 . "NOT>"))))) (princ "\nPas d'objets valable ou sélection vide!") ) (initget 5) (setq th_start (getdist "\nLargeur de départ: ")) (initget 5) (setq th_end (getdist "\nLargeur de fin: ")) (repeat (setq n (sslength js)) (setq ent (ssname js (setq n (1- n))) obj (vlax-ename->vla-object ent) ) (cond ((eq (setq flag_close (vla-Get-Closed obj)) ':vlax-true) (vla-Put-Closed obj ':vlax-false) ) ) (setq param_curve (vlax-curve-getEndParam obj) perim_curve (vlax-curve-getDistAtParam obj param_curve) w_end th_end ) (vla-SetWidth obj param_curve w_end th_end ) (repeat (setq nb_vtx (1- (fix param_curve))) (vla-SetWidth obj nb_vtx (setq w_start (+ th_start (* (/ (- th_end th_start) perim_curve) (vlax-curve-getDistAtParam obj nb_vtx)))) w_end ) (setq w_end w_start nb_vtx (1- nb_vtx)) ) (vla-SetWidth obj nb_vtx th_start w_end ) (vla-Put-Closed obj flag_close) ) (prin1) )

Beaucoup de déboires avec les MAJ de window 10, surtout les builds. C'est plus Microsoft qui est à incriminer qu'Autodesk! Lors de la MAJ précédente de la build, autocad ne voulait plus se lancer. Obliger de désinstaller complétement le produit, de nettoyer la base de registre, de lancer la console de dépannage de windows pour remettre le MBR vierge et enfin de réinstaller le produit. Avec cet manip, Autocad a refonctionner correctement. Lors de la dernière mise à jour de build (Update Creator), déjà la mise à jour à bloquer à 99%, impossible de terminer. Bon je suis peut être responsable car j'avais bidouillé la base de registre pour désactiver l'envoi de données télémétrique. Toujours est-il que j'ai du reinstaller complétement window 10 à partir d'une clé USB avec la dernière build. L'installation des produits Autodesk c'est alors bien passé, par contre il ne voulait pas de mon anti-virus et m'imposait windows defender. Kapersky a rué dans les brancards et depuis j'ai pu réactivé ma licence Kapersky. Donc les mises à jour de Microsoft ne sont pas forcément honnête et peu foutre facilement le bazard dans des applications non microsoft: Concurence déloyale... Mais bon, la dernière build une fois installée et quand même pas mal, on peut désactiver plus facilement (sans bidouiller) les envois de données à microsoft, mais il peut rester des portes dérobées que personnes connait. Mon Autocad Map 2014 tourne parfaitement, mais je redoute toujours les mises à jour importantes de window. Choississez un moment opportun pour les faire, pas quand vous avez réellemnt besoin du PC.

Un guillemet qui avait sauté lors du copier-coller, j'ai corrigé... Recopie à nouveau le code!

Bonjour, Les lignes de rappel, entité LEADER, permettent d’insérer des champs mais malheureusement la localisation du départ de la ligne de rappel n'est pas disponible. Je vous propose donc d'écrire les coordonnées avec une façon un peu similaire à une ligne de rappel. Le programme fonctionne dans tout les SCU, mais retournera la valeur des coordonnées TOUJOURS depuis le SCG. (defun c:coord-xy_field ( / AcDoc Space pt_pos pt_field htx rtx ncol ocs op dlt1 dlt2 obj js nw_obj l_max lst_pt p1 p2 p3 nw_pl) (vl-load-com) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (while (setq pt_pos (getpoint "\nPosition à repérer?: ")) (initget 9) (setq pt_field (getpoint pt_pos "\nEmplacement du texte?: ")) (initget 6) (setq htx (getdist pt_field (strcat "\nSpécifiez la hauteur du champ <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (if (not (setq rtx (getorient pt_field "\nSpécifiez l'orientation du champ <0.0>: "))) (setq rtx 0.0)) (setq ncol '(131 160) ocs (trans '(0.0 0.0 1.0) 1 0 T) op (if (and (> (angle pt_pos pt_field) (* pi 0.5)) (<= (angle pt_pos pt_field) (* 1.5 pi))) T nil) dlt1 (list ((if op + -) (* (getvar "TEXTSIZE") (cos rtx)) (* (* (getvar "TEXTSIZE") 0.5) (sin rtx))) ((if op - +) (* (getvar "TEXTSIZE") (sin rtx)) (* (* (getvar "TEXTSIZE") 0.5) (cos rtx))) 0.0 ) dlt2 (list ((if op + -) (* (getvar "TEXTSIZE") (cos rtx)) (* (- (* (getvar "TEXTSIZE") 0.5)) (sin rtx))) ((if op - +) (* (getvar "TEXTSIZE") (sin rtx)) (* (- (* (getvar "TEXTSIZE") 0.5)) (cos rtx))) 0.0 ) ) (foreach n '("Id-XY" "Id-Point") (cond ((null (tblsearch "LAYER" n)) (vlax-put (vla-add (vla-get-layers AcDoc) n) 'color (car ncol)) ) ) (setq ncol (cdr ncol)) ) (cond ((null (tblsearch "STYLE" "Coord-Field")) (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Coord-Field")) (mapcar '(lambda (pr val) (vlax-put nw_style pr val) ) (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag) (list (strcat (getenv "windir") "\\fonts\\arial.ttf") 0.0 (/ (* 15.0 pi) 180) 1.0 0.0) ) ) ) (vlax-put (vla-AddPoint Space (vlax-3d-point (trans pt_pos 1 0))) 'layer "Id-Point") (setq obj (entlast) js (ssadd)) (mapcar '(lambda (lx) (apply '(lambda (ins_point value_field att_point txt_height dwg_dir v_norm txt_rot name_style name_layer / nw_obj) (setq nw_obj (vla-addMtext Space (vlax-3d-point ins_point) 0.0 (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-ObjectID (vlax-ename->vla-object obj))) value_field ) ) js (ssadd (entlast) js) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'Normal 'Rotation 'StyleName 'Layer) (list att_point txt_height dwg_dir ins_point v_norm txt_rot name_style name_layer) ) ) lx ) ) (list (list (trans (if op (mapcar '- pt_field dlt1) (mapcar '+ pt_field dlt1)) 1 0) ">%).Coordinates \\f \"%lu2%pt1%pr3%ps[X= ,]\">%" (if op 9 7) (getvar "TEXTSIZE") 5 ocs rtx "Coord-Field" "Id-XY" ) (list (trans (if op (mapcar '- pt_field dlt2) (mapcar '+ pt_field dlt2)) 1 0) ">%).Coordinates \\f \"%lu2%pt2%pr3%ps[Y= ,]\">%" (if op 3 1) (getvar "TEXTSIZE") 5 ocs rtx "Coord-Field" "Id-XY" ) ) ) (setq l_max nil) (foreach n (append (textbox (list (assoc 1 (entget (ssname js 0))))) (textbox (list (assoc 1 (entget (ssname js 1)))))) (setq l_max (cons (apply 'max n) l_max))) (setq l_max (apply 'max l_max) lst_pt (list (trans pt_pos 1 ocs) (trans pt_field 1 ocs) (trans (setq p1 (polar pt_field (+ rtx (* 0.5 pi)) (* 2.0 (getvar "TEXTSIZE")))) 1 ocs) (trans (setq p2 (polar p1 (if op (+ pi rtx) rtx) (+ l_max (* (getvar "TEXTSIZE") 3.0)))) 1 ocs) (trans (setq p3 (polar p2 (- rtx (* 0.5 pi)) (* 4.0 (getvar "TEXTSIZE")))) 1 ocs) (trans (polar p3 (if op rtx (+ pi rtx)) (+ l_max (* (getvar "TEXTSIZE") 3.0))) 1 ocs) ) ) (setq nw_pl (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar 'list (mapcar 'car lst_pt) (mapcar 'cadr lst_pt))) ) ) (vlax-put nw_pl 'Closed 1) (vlax-put nw_pl 'Elevation (caddr (trans (trans pt_pos 1 0) 0 1 T))) (vlax-put nw_pl 'Layer "Id-XY") ) (prin1) )

Bonjour, Il y aussi celle ci qui fait le distinguo entre 3 et 4 côtés (defun C:3dfto3dpo ( / js ind e_name ent dxf_10 dxf_11 dxf_12 dxf_13) (setvar "cmdecho" 0) (princ "\nChoix des 3Dfaces.") (setq js (ssget '((0 . "3DFACE"))) ind 0) (cond (js (setvar "osmode" (+ 16384 (rem (getvar "osmode") 16384))) (while (setq e_name (ssname js ind)) (setq ind (1+ ind) ent (entget e_name) dxf_10 (trans (cdr (assoc 10 ent)) 0 1) dxf_11 (trans (cdr (assoc 11 ent)) 0 1) dxf_12 (trans (cdr (assoc 12 ent)) 0 1) dxf_13 (trans (cdr (assoc 13 ent)) 0 1) ) (if (not (equal dxf_12 dxf_13 1E-012)) (command "_.3dpoly" dxf_10 dxf_11 dxf_12 dxf_13 "_close") (command "_.3dpoly" dxf_10 dxf_11 dxf_12 "_close") ) ) (princ (strcat "\n" (itoa ind) " 3Dpoly crées à partir de 3Dface.")) (setvar "osmode" (rem (getvar "osmode") 16384)) ) (T (prompt "\nAucune sélection valide.")) ) (setvar "cmdecho" 1) (prin1) )

Oops une confusion de terme (problème de dyslexie?), je pensais a WOT et pas QWANT. Donc cocorico, pas d'avis négatif sur Qwant. Désolé!

AdBlock, si il est efficace, il est moyen au niveau lourdeur de fonctionnement et confidentialité. Je lui préfère Ublock origin. Quand à Qwant à éviter Donc mes choix: Ublock origin Decentaleyes NoScript (Efficace, mais parfois pénible à gérer) voir -> Wiki de sebsauvage.net Avec en plus un peu de bon sens, l'utilisateur lambda surfe serein! J'utilise aussi https://www.startpage.com/ comme moteur de recherche

Bonjour, (ade_odsetfield ent "RACCORD" "PRECISION" "C") n'est pas correct! (ade_odsetfield ent "RACCORD" "PRECISION" 0 "C") est correct. ent est la variable du nom de ton entité à traitée. 0 est l'indice du numéro d'enregistrement. (si différent de zéro tu empile tes données, autrement tu écrase la donnée) depuis (setq sel (car (SelParODValLsp "RACCORD" "PRECISION" "" ))) il faut te faire une boucle pour traiter les entités contenu dans ton jeu de séléction cela pourrait être (cond (sel (repeat (setq n (sslength sel)) (setq ent (ssname sel (setq n (1- n)))) (ade_odsetfield ent "RACCORD" "PRECISION" 0 "C") ) ) )

Salut, Je tenterais par les fonctions ARX, notamment la fonction geom3d.arx Voici un exemple de test pour savoir si la fonction est chargée. Je pense que cela répondrai à ta demande.

Ceci me semble réalisable sans lisp. Je considère que "VegArbFeuil1" n'existe pas dans le dessin à traiter. Utiliser la commande RENOMMER (_RENAME), prendre l'option bloc, ancien nom: "FARBRE" nouveau nom: "VegArbFeuil1". Tous les blocs insérés sont ainsi renommé. Utiliser alors la commande INSERER (_INSERT), parcourir dans votre bibliothèque externe et choisir le fichier VegArbFeuil1.dwg. Lorsqu'il aura été sélectionné, un message va vous demander de confirmer la redéfinition du bloc, annuler l'insertion (le bloc a été redéfini), c'est fini!

Voici ce qu'il te faudra changer dans le code pour répondre à tes demandes. Pour la hauteur du texte, au lieu de changer ton gabarit fait simplement ce rajout: (setvar "TEXTSIZE" 300.0) devant les lignes NB: (getdist) permet la saisie à l'écran, MAIS la saisie d'une valeur numérique au clavier est permise, autrement changer (getdist) par (getreal) qui ne permet que la saisie au clavier. pour le nom du calque par défaut subtitut les lignes par: (princ (strcat "\nLe nom du calque est :" (cdr (assoc 8 dxf_cod)))) (setq nam_lay (getstring "\nEntrez le(s) nom(s) du/des calque(s) à traiter? <_METRES*>: " T)) (if (eq nam_lay "") (setq nam_lay "_METRES*")) (setq dxf_cod (subst (cons 8 nam_lay) (assoc 8 dxf_cod) dxf_cod)) mettre nam_lay en variable locale sera plus propre. NB: (getstring "message" T) permet la saisie d'espace dans le nom du calque, donc obligation de validation de la valeur par défaut par la touche ENTREE. Si tu supprime le T, la validation par la barre espace sera possible mais tu ne pourra fournir d'espace dans le nom du calque, à toi de voir. Intéresse toi à la ligne de la variable pt: tu pourrais faire par exemple: (vlax-3d-point (setq pt (polar pt (+ rtx (* pi 0.5)) (* 2.0 (getvar "TEXTSIZE"))))) Entraine toi à faire ces modifs, bon courage.

Alors pour ton besoin propre cela donnerai ceci. Le nom du calque de l'entité sélectionné te sera retourné comme modèle, exemple: Calque1 (avec des lignes existant sous Calque1 .... à Calque9) Au message Entrez le(s) nom(s) du/des calque(s) à traiter? :, tu peux soit utiliser les jokers (* ou ?), par exemple : Calque* ou Calque1,Calque3,Calque5 (séparation de chaque calque par une virgule ,. ATTENTION aux fautes de frappe pour les noms de calques, aucun contrôle de validité est effectué. Le résultat subira un facteur multiplicatif de 0.001 (pour faire une conversion de mm en m) (vl-load-com) (defun c:RemiW ( / js obj AcDoc Space nw_style pt htx rtx unit_key unit_draw dxf_cod n ename m-param deriv nw_obj lremov) (princ "\nSélectionnez un objet curviligne.") (while (null (setq js (ssget "_+.:E:S" (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>") ) ) ) ) (princ "\nCe n'est pas un objet curviligne valable pour cette fonction!") ) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du champ <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (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" "Id-Longueurs")) (vlax-put (vla-add (vla-get-layers AcDoc) "Id-Longueurs") 'color 96) ) ) (cond ((null (tblsearch "STYLE" "Text-Field")) (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Text-Field")) (mapcar '(lambda (pr val) (vlax-put nw_style pr val) ) (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag) (list (strcat (getenv "windir") "\\fonts\\arial.ttf") 0.0 (/ (* 15.0 pi) 180) 1.0 0.0) ) ) ) (if (or (eq (getvar "USERS5") "") (not (eq (substr (getvar "USERS5") 1 2) "qz"))) (progn (initget "KM ME CM MM") (if (not (setq unit_key (getkword "\nDessin réalisé en [KM/ME/CM/MM] <ME>: "))) (setq unit_key "ME") ) (cond ((eq unit_key "KM") (setq unit_draw 1000000) ) ((eq unit_key "ME") (setq unit_draw 1000 unit_key "M") ) ((eq unit_key "CM") (setq unit_draw 10) ) ((eq unit_key "MM") (setq unit_draw 1) ) ) (setvar "USERS5" (strcat "qz" (itoa unit_draw))) ) (progn (setq unit_draw (atoi (substr (getvar "USERS5") 3))) (cond ((eq unit_draw 1000000) (setq unit_key "KM") ) ((eq unit_draw 1000) (setq unit_key "M") ) ((eq unit_draw 10) (setq unit_key "CM") ) ((eq unit_draw 1) (setq unit_key "MM") ) ) ) ) (initget "Unique Multiple _Single Multiple") (if (eq (getkword "\nSélection filtrée [unique/Multiple]<M>: ") "Single") (setq n -1) (progn (setq dxf_cod (entget (ssname js 0)) ) (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8))) (setq lremov (cons (car n) lremov)))) (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod)) ) (princ (strcat "\nLe nom du calque est :" (cdr (assoc 8 dxf_cod)))) (setq dxf_cod (subst (cons 8 (getstring "\nEntrez le(s) nom(s) du/des calque(s) à traiter? : " T)) (assoc 8 dxf_cod) dxf_cod)) (setq js (ssget "_X" dxf_cod) n -1 ) ) ) (repeat (sslength js) (setq obj (ssname js (setq n (1+ n))) ename (vlax-ename->vla-object obj) pt (vlax-curve-getPointAtDist ename (* (vlax-get ename (cond ((eq (vla-get-ObjectName ename) "AcDbArc") 'ArcLength) ((eq (vla-get-ObjectName ename) "AcDbCircle") 'Circumference) (T 'Length) ) ) 0.5) ) deriv (vlax-curve-getFirstDeriv ename (if (eq (vla-get-ObjectName ename) "AcDbLine") (* 0.5 (vlax-get ename 'Length)) (vlax-curve-getParamAtPoint ename pt) ) ) rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR"))) ) (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi))) (setq nw_obj (vla-addMtext Space (vlax-3d-point (setq pt (polar pt (+ rtx (* pi 0.5)) (getvar "TEXTSIZE")))) 0.0 (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-ObjectID (vlax-ename->vla-object obj))) ">%)." (cond ((eq (vla-get-ObjectName (vlax-ename->vla-object obj)) "AcDbArc") "ArcLength" ) ((eq (vla-get-ObjectName (vlax-ename->vla-object obj)) "AcDbCircle") "Circumference" ) (T "Length" ) ) " \\f \"%lu2%pr2%ps[L=," (strcase unit_key T) "]%ct8[0.001]\">%" ) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation) (list 5 (getvar "TEXTSIZE") 5 pt "Text-Field" "Id-Longueurs" rtx) ) ) (prin1) )

J'ai aucun mérite car je ne le connaissais pas non-plus, je l'ai pompé sur un code de (gile) que j'ai retrouvé sur les forums d'AutoDesk. Merci à lui.

Bonjour, Je l'avais certainement déjà publié sur CadXp, mais comme il a pu changer depuis je préfère le republier. Voir si ça te convient, cela permet de mettre en place des champs dynamique concernant la longueur d'entité. Celle-ci peuvent être des lignes, polylignes, arc ou cercle. Elle peut être appliquée de manière unique ou multiple: multiple fera la même chose pour toutes les entités ayant les mêmes propriétés que le modèle sélectionné au départ. (vl-load-com) (defun c:CurveLength_Field ( / js obj AcDoc Space nw_style pt htx rtx unit_key unit_draw dxf_cod n ename m-param deriv nw_obj lremov) (princ "\nSélectionnez un objet curviligne.") (while (null (setq js (ssget "_+.:E:S" (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>") ) ) ) ) (princ "\nCe n'est pas un objet curviligne valable pour cette fonction!") ) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du champ <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (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" "Id-Longueurs")) (vlax-put (vla-add (vla-get-layers AcDoc) "Id-Longueurs") 'color 96) ) ) (cond ((null (tblsearch "STYLE" "Text-Field")) (setq nw_style (vla-add (vla-get-textstyles AcDoc) "Text-Field")) (mapcar '(lambda (pr val) (vlax-put nw_style pr val) ) (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag) (list (strcat (getenv "windir") "\\fonts\\arial.ttf") 0.0 (/ (* 15.0 pi) 180) 1.0 0.0) ) ) ) (if (or (eq (getvar "USERS5") "") (not (eq (substr (getvar "USERS5") 1 2) "qz"))) (progn (initget "KM ME CM MM") (if (not (setq unit_key (getkword "\nDessin réalisé en [KM/ME/CM/MM] <ME>: "))) (setq unit_key "ME") ) (cond ((eq unit_key "KM") (setq unit_draw 1000000) ) ((eq unit_key "ME") (setq unit_draw 1000 unit_key "M") ) ((eq unit_key "CM") (setq unit_draw 10) ) ((eq unit_key "MM") (setq unit_draw 1) ) ) (setvar "USERS5" (strcat "qz" (itoa unit_draw))) ) (progn (setq unit_draw (atoi (substr (getvar "USERS5") 3))) (cond ((eq unit_draw 1000000) (setq unit_key "KM") ) ((eq unit_draw 1000) (setq unit_key "M") ) ((eq unit_draw 10) (setq unit_key "CM") ) ((eq unit_draw 1) (setq unit_key "MM") ) ) ) ) (initget "Unique Multiple _Single Multiple") (if (eq (getkword "\nSélection filtrée [unique/Multiple]<M>: ") "Single") (setq n -1) (setq dxf_cod (entget (ssname js 0)) js (ssget "_X" (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov)))) (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod)) ) ) n -1 ) ) (repeat (sslength js) (setq obj (ssname js (setq n (1+ n))) ename (vlax-ename->vla-object obj) pt (vlax-curve-getPointAtDist ename (* (vlax-get ename (cond ((eq (vla-get-ObjectName ename) "AcDbArc") 'ArcLength) ((eq (vla-get-ObjectName ename) "AcDbCircle") 'Circumference) (T 'Length) ) ) 0.5) ) deriv (vlax-curve-getFirstDeriv ename (if (eq (vla-get-ObjectName ename) "AcDbLine") (* 0.5 (vlax-get ename 'Length)) (vlax-curve-getParamAtPoint ename pt) ) ) rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR"))) ) (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi))) (setq nw_obj (vla-addMtext Space (vlax-3d-point (setq pt (polar pt (+ rtx (* pi 0.5)) (getvar "TEXTSIZE")))) 0.0 (strcat "%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-ObjectID (vlax-ename->vla-object obj))) ">%)." (cond ((eq (vla-get-ObjectName (vlax-ename->vla-object obj)) "AcDbArc") "ArcLength" ) ((eq (vla-get-ObjectName (vlax-ename->vla-object obj)) "AcDbCircle") "Circumference" ) (T "Length" ) ) " \\f \"%lu2%pr2%ps[L=," (strcase unit_key T) "]\">%" ) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation) (list 5 (getvar "TEXTSIZE") 5 pt "Text-Field" "Id-Longueurs" rtx) ) ) (prin1) )

Pour ma part j'ai cherché en vlisp, mais j'ai un petit souci que je ne sais résoudre: C'est pour déterminer la variable dxf_210 avec 'PrincipalDirections qui retourne 9 éléments. Des fois ça peut être les 3 premier, les 3 du milieu ou les 3 dernier. Je donne ce que j'ai fais (qui fonctionne bien avec les cylindre créés dans le SCG). (defun c:cyl2cer ( / js n ent dxf_ent cyl pt_pos height radius dxf_210) (cond ((setq js (ssget '((0 . "3DSOLID")))) (repeat (setq n (sslength js)) (setq ent (ssname js (setq n (1- n))) dxf_ent (entget ent) cyl (vlax-ename->vla-object ent) ) (cond ((= (vl-catch-all-apply 'vla-get-SolidType (list cyl)) "Cylindre") (setq pt_pos (vlax-get cyl 'Position) height (* 2 (distance pt_pos (vlax-get cyl 'centroid))) radius (sqrt (/ (vla-get-Volume cyl) (* pi height))) dxf_210 (cdddr (cdddr (vlax-get cyl 'PrincipalDirections))) ) (vla-delete cyl) (entmake (list (cons 0 "CIRCLE") (assoc 67 dxf_ent) (assoc 410 dxf_ent) (assoc 8 dxf_ent) (if (assoc 62 dxf_ent) (assoc 62 dxf_ent) (cons 62 256) ) (cons 39 height) (cons 10 (trans pt_pos 0 dxf_210)) (cons 40 radius) (cons 210 dxf_210) ) ) ) ) ) ) ) )

Bonjour, Que retourne ceci sur une polyligne non remplie? (strcat (rtos (car (setq vec (cdr (assoc 210 (setq dxf (entget (car (entsel)))))))) 2 16) "," (rtos (cadr vec) 2 16) "," (rtos (caddr vec) 2 16)) Si c'est autre que "0.000000000000000,0.000000000000000,1.000000000000000", ta polyligne a été tracé dans un SCU non parallèle au SCG et donc le remplissage n'est pas visible sauf si tu es dans le scu de création.

J'ai adapté rapidement ma proposition à ta version V3. Je n'ai pas fais de tests d'utilisation autre que sur ton DWG d'exemple. Une fonction attend un nombre mais nil lui est fournie. Un petit coup de pouce! (vl-string-search "_" "chaine ou trouver le caractère") Si celui-ci n'est pas trouvé, le retour est nil, et faire une soustraction avec entraine une erreur...

Et ce n'est que le début, y aura t-il une révolution sur les claviers Français?! Azerty (amélioré) ou Bépo?

Le mapcar et le lambda n'était là que pour appliquer la fonction à une liste quelconque (et non pas à une liste exacte comme tu as l'air de le penser). Si j'applique ce que je t'ais proposé dans ton code où tu fais une boucle while (donc plus besoin de traiter une liste mais seulement un élément), cela donnerait ceci (tu pourra commenter le (princ ..) qui te trace la conversion. (defun c:RemplBlkV4 ( / ss i ent elst BlkNom Resultat indexs NouvBlkNom) (princ "\nDéveloppé par Denis H.") ;;; Remplacement des blocs incrémentés * (princ "\nRemplacement des blocs incrémentés...") (setq ss nil i 0 ) ;_ Fin de setq (if (setq ss (ssget "_X" '((0 . "INSERT")))) (progn (while (setq ent (ssname ss i)) (setq i (1+ i) elst (entget ent) BlkNom (cdr (assoc 2 elst)) ) ;_ Fin de setq (setq Resultat (vl-string->list BlkNom)) (setq index (- (length Resultat) (vl-string-search "_" (vl-list->string (reverse Resultat))))) (setq NouvBlkNom (if (eq (type (read (substr BlkNom (1+ index)))) 'INT) (substr BlkNom 1 (1- index)) BlkNom ) ) (princ (strcat "\nAncien bloc: " BlkNom " -> Nouveau bloc: " NouvBlkNom)) (if (/= NouvBlkNom BlkNom) (progn (setq elst (subst (cons 2 NouvBlkNom) (assoc 2 elst) elst)) ; (entmod elst) ) ;_ Fin de progn ) ;_ Fin de if ) ;_ Fin de while ) ;_ Fin de progn ) ;_ Fin de if (princ) )

Soit une liste "lst" par exemple comme ton exemple. (setq lst '("POTEAU_BOIS" "POTEAU_BOIS_01" "POTEAU_BOIS_02" "POTEAU_BOIS_03" "POTEAU_BOIS_121" "POTEAU_BOIS_MOISE" "POTEAU_BOIS_MOISE_1" "POTEAU_BOIS_MOISE_2" "POTEAU_BOIS_MOISE_145")) Ces quelques lignes devraient écarter seulement les indicés par un nombre. (setq ln (mapcar 'vl-string->list lst)) (setq lindx (mapcar '(lambda (el / ) (- (length el) (vl-string-search "_" (vl-list->string (reverse el))))) ln)) (mapcar '(lambda (ch i / ) (if (eq (type (read (substr ch (1+ i)))) 'INT) (substr ch 1 (1- i)) ch ) ) lst lindx )

Bonsoir Olivier, Gérer un reseau filaire sous AutocadMap a été pour moi assez casse-tête. Mais à force je peux dire que je me suis fais des outils qui me satisfont. Ma problématique était de découper ce filaire avec une notion de repérage propre au réseau routier (Point Routier) qui sont des points de repérage sur le curviligne du tracé de l'axe routier. Donc pouvoir découper en tronçon en maintenant la table de repérage automatiquement. C'est à dire que la table de données d'objet lié au repérage est automatiquement calculée par la routine et les valeur sont mises à jour, toutes les autre tables existantes sont dupliquées sur le tronçon sectionné avec les valeurs d'enregistrements (qu'il y ait 1 ou n records) Cette routine m'a permis de "saucissonner" au fur et mesure des besoins mon réseau filaire pour y affecter de nouvelle tables ou les modifier avec des valeurs applicable à un tronçon. Mais comme gégé c'est un développement spécifique est non portable. Comme lui ça devient un peu usine à gaz quand je tente de faire toutes ces actions de découpage à partir de l'import d'un fichier issu d'excel. Dans l'ensemble ça fonctionne, mais des cas très particulier sont traité pas toujours comme on l'entendrait (heureusement MQSELECT existe et est bien utile pour contrôler l'aboutissement) Je pense que tu ne peux échapper à un développement propre à tes besoins pour pouvoir le faire sur Autocad. Je te joins un fichier dwg d'exemple avec une routine aboutie pour mes besoins pour que tu te rende compte éventuellement des pistes à explorer si tu le souhaites. Le fichier dessin de test La routine lisp

L'essentiel est que j'ai pu cerner ton besoin pour le concrétiser... Impressionnant la machine outil, c'est pas de la maquette Le code a été mis à jour dans mon post précédent. Contrôle quand même les résultats, je suis pas à l'abri de faire des boulettes et ça me ferais mal d'être responsable indirectement d'une malfaçon et surtout des coûts qui pourrait en découler. NB: Si dans le même fichier dessin, la commande "cercle2mpf" est relancée pour traiter par exemple des cercles avec d'autres rayons, les données seront alors RAJOUTEES au fichier. mpf selon le même schéma. Je tenais à le préciser... La précision est à deux chiffre après la virgule comme dans ton exemple, elle peut être augmenté (voir la fonction (rtos) dans le code)

Bon, j'ai pas eu vraiment réponse à mes questions. Voilà ce que j'ai fais en ayant compris comme je pouvais. Cela écrit directement dans le fichier au format préconisé. (defun def_date (td / j y d m) (setq j (- (fix td) 1721119.0)) (setq y (fix (/ (1- (* 4 j)) 146097.0))) (setq j (- (* j 4.0) 1.0 (* 146097.0 y))) (setq d (fix (/ j 4.0))) (setq j (fix (/ (+ (* 4.0 d) 3.0) 1461.0))) (setq d (- (+ (* 4.0 d) 3.0) (* 1461.0 j))) (setq d (fix (/ (+ d 4.0) 4.0))) (setq m (fix (/ (- (* 5.0 d) 3) 153.0))) (setq d (- (* 5.0 d) 3.0 (* 153.0 m))) (setq d (fix (/ (+ d 5.0) 5.0))) (setq y (+ (* 100.0 y) j)) (if (< m 10.0) (setq m (+ m 3)) (progn (setq m (- m 9)) (setq y (1+ y)) ) ) (strcat (itoa (fix d)) "/" (itoa (fix m)) "/" (itoa (fix y)) ) ) (defun c:cercle2mpf ( / js dxf_cod lremov count n i file2open f_open js_one dxf_ent base_pt nw_pt write_pt) (princ "\nChoix d'un cercle modèle pour le filtrage: ") (while (null (setq js (ssget "_+.:E:S" (list '(0 . "CIRCLE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) ) ) (princ "\nCe n'est pas un objet cercle valable pour cette fonction!") ) (if (not (tblsearch "LAYER" "UT1")) (entmake '( (0 . "LAYER") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "UT1") (70 . 0) (62 . 3) (6 . "Continuous") (290 . 1) (370 . -3) ) ) ) (setq dxf_cod (entget (ssname js 0)) js (ssget "_X" (foreach m (foreach n dxf_cod (if (not (member (car n) '(0 40 67 410 8 6 62 48 420 70))) (setq lremov (cons (car n) lremov)))) (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod)) ) ) count 0 n (sslength js) ) (repeat (setq i (sslength js)) (redraw (ssname js (setq i (1- i))) 3) ) (setq file2open (strcat (getvar "DWGPREFIX") (vl-string-right-trim ".dwg" (getvar "DWGNAME")) ".mpf")) (setq f_open (open file2open (if (findfile file2open) "a" "w"))) (princ (strcat ";Date :" (def_date (getvar "TDCREATE"))) f_open) (princ "\n;Travail N.:" f_open) (princ "\n;Plans N.:" f_open) (princ "\n;Notes :" f_open) (princ "\nGOTOF \"N\"<<R199" f_open) (while (< count n) (princ (strcat "\nDésignez votre cercle " (itoa (1+ count)))) (while (not (setq js_one (ssget "_+.:E:S" dxf_cod)))) (setq ent (ssname js_one 0)) (cond ((and js_one (ssmemb ent js)) (ssdel ent js) (setq dxf_ent (entget ent)) (cond ((zerop count) (setq base_pt (cdr (assoc 10 dxf_ent))) (setq nw_pt '(0.0 0.0 0.0)) ) (T (setq nw_pt (cdr (assoc 10 dxf_ent))) ) ) (entmod (subst '(8 . "UT1") (assoc 8 dxf_ent) dxf_ent)) (entmake (list '(0 . "TEXT") '(8 . "UT1") '(10 0.0 0.0 0.0) (cons 11 (cdr (assoc 10 dxf_ent))) (cons 40 (* (cdr (assoc 40 dxf_ent)) 0.5)) (cons 1 (itoa (1+ count))) '(50 . 0) '(71 . 0) '(72 . 1) '(73 . 2) ) ) (setq write_pt (if (zerop count) nw_pt (mapcar '- nw_pt base_pt)) count (1+ count) ) (princ (strcat "\nN" (itoa count) " X" (if (zerop (car write_pt)) (rtos (car write_pt) 2 0) (rtos (car write_pt) 2 2)) " Y" (if (zerop (cadr write_pt)) (rtos (cadr write_pt) 2 0) (rtos (cadr write_pt) 2 2)) ) f_open ) (redraw ent 4) ) ) ) (princ "\nM17\n" f_open) (close f_open) (princ (strcat "\nDonnées écrites dans " file2open)) (prin1) )

Pour qu'on ce comprenne bien, ce que j'ai surligné en rouge dans tes propos, cela veut dire que c'est toi qui désigne UN à UN tes cercles pour leur assigner un ordre de traçage pour ta machine? Cela n'a rien à voir avec l'ordre dont le cercle à été tracé dans Autocad, si je comprends bien? (ce que j'ai tenté de faire dans le lisp proposé) Si c'est cela, effectivement ton code proposé en 1er lieu n'est pas loin, au lieu d'écrire le texte dans le dessin, il suffit d'écrire les données dans un fichier (Quel est l'extension de celui-ci d'ailleurs?), au lieu de passé par l'extraction de données.