bonuscad

Bonjour, Ces données ne sont pas publique. Ceci pour éviter que n'importe qui puisse connaître le patrimoine d'une personne. Sans connaître les démarches a effectuer, il me semble qu'il faut obtenir une accréditation en justifiant pourquoi tu as besoin de ces données. Une fois obtenue tu auras alors un compte pour pouvoir accéder à celles-ci.

Tout dépend du contexte, ce que tu ne décrit pas! Est-ce, par exemple de la voirie de lotissement ou des voies de circulation du domaine public. Pour des voies du domaine public, il y a des règles à respecter. Pour des voies à grande circulation on utilise des alignement droit, des courbes et très souvent (pour le confort de l'usager) des courbes à rayon progressif appelées clothoïde. Ces dernières permettent ainsi au conducteur d'avoir un mouvement graduel sur le volant et d'introduire une variation du dévers. Les paramètres dépendent de la vitesse de référence de la voie: autoroute, voie express, nationale, départementale, voie ferrée.... La force centripète avec le dévers peut éviter une sortie de route en cas de verglas notamment. On peut déroger à ces règles en milieu difficile, par exemple en zone de montagne. Le profil en long ou carrefour peut aussi influencer le choix de la courbe (question de visibilité) En tout cas les Splines ne font pas du tout partie de la constitution d'un axe en plan. Donc a minima alignement droit et courbe, dans ce cas la variation de dévers se fera de préférence dans l'alignement droit pour avoir un dévers unique dans la courbe (si la longueur de l'alignement droit le permet, autrement on peut mordre sur une partie de la courbe) Ça reste un métier, on ne l'invente pas. Trouve de la documentation si tu n'as aucune connaissance (ICTARN ICTAAL)

Bonjour, Ça ne me rajeunie pas, cette routine date de longtemps (Autocad 2002) Depuis j'avais réécris complètement le code et proposé celui-ci sur CadXp. Malgré qu'il s’appelle Talus3D, celui peut produire aussi des talus avec des entités en 2D. Il n'y a plus de boite de dialogue (.dcl) ni de fichier de cliché (.slb). Voici le lien sur le site TALUS3D.lsp

Bonjour, Un sujet similaire. Le code proposé dans ce lien peut être facilement adaptable selon tes besoins mais il faut en savoir un peu plus...

Bonjour, Je t’ai répondu ICI. Je remet ici ma proposition en ayant amélioré le code: établissement du calque avec sa couleur et affectation de l'élévation avec les décimales arrondies aux polylignes (tant qu'à faire) https://www.cadtutor.net/forum/topic/92684-change-contour-line-layer-according-to-altitude/?do=findComment&comment=654523 (defun c:MAJCL ( / ss l c n dxf_ent elev nam_lay) (setq ss (ssget "_X" '((0 . "LWPOLYLINE") (8 . "Terrain - Cont. - Contours")))) (cond (ss (setq l '(0.5 1.0 2.0 5.0 10.0 25.0 50.0 100.0) c '(121 51 7 241 211 253 91 141) ) (repeat (setq n (sslength ss)) (setq dxf_ent (entget (ssname ss (setq n (1- n)))) elev (read (rtos (cdr (assoc 38 dxf_ent)) 2 1)) ) (mapcar '(lambda (x) (if (and (zerop (rem elev (car x))) (null (assoc 62 dxf_ent))) (progn (setq nam_lay (strcat "_NB-MajorLine_" (if (eq (car x) (fix (car x))) (rtos (car x) 2 0) (rtos (car x) 2 1)))) (if (not (tblsearch "LAYER" nam_lay)) (entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 nam_lay) (cons 70 0) (cons 62 (cdr x)) (cons 370 -3) (cons 6 "Continuous") ) ) ) (setq dxf_ent (subst (cons 8 nam_lay) (assoc 8 dxf_ent) dxf_ent ) dxf_ent (subst (cons 38 elev) (assoc 38 dxf_ent) dxf_ent ) ) (entmod dxf_ent) ) ) ) (mapcar 'cons l c) ) ) ) ) )

Excusez, mais je veux réagir brièvement à ce ce sujet. l'I.A. est pour moi du même acabit que les calculateur automobile. Merci le mécano de mes deux, c'est la pompe de gavage et c'est pas le même prix! (vécu) Je vous laisse réfléchir aux diagnostiques de ces "intelligences" et celui du pseudo mécanicien aussi. Bien à vous.

Quand (gile) m'a fait remarqué que je devais enlever le caractère /, je me suis dit qu'il serait bien de le conserver pour lire dans le système impérial et fractionnaire. Mais malheureusement je me suis heurté à la lecture du caractère du pouce (") qui m'a posé problème: le lisp utilisant ce caractère pour encadrer une chaîne... Du coup j'ai laissé tomber rapidement !... @VDH-Bruno Bonne fête à toi aussi 😁

Pour info il y a une discussion similaire sur le forum Autodesk et l'utilisateur à soulevé un problème, que je pense avoir résolu. Je l'adapte à ma proposition faite ici, essaye cette version... (defun c:test ( / ss dfzz count n progress i ent dxf_ent pt_ins ss_pl tmp j ent_pl pt prm a_ref deriv alpha n_ent dxf_next) (setq ss (ssget '((0 . "INSERT") (2 . "TCPOINT")))) (cond (ss (if (zerop (getvar "USERR1")) (setvar "USERR1" 1E-02) (getvar "USERR1")) (initget 4) (if (not (setq dfzz (getdist (strcat "\nRayon de recherche? <" (rtos (getvar "USERR1") 2 2) "> : ")))) (setq dfzz (getvar "USERR1")) (setvar "USERR1" dfzz) ) (setq count 0 progress (setq n (sslength ss)) i 0 ) (acet-ui-progress-init "Progression:" progress) (repeat n (setq ent (ssname ss (setq n (1- n))) dxf_ent (entget ent) pt_ins (cdr (assoc 10 dxf_ent)) ss_pl (ssget "_C" (trans (mapcar '- pt_ins (list dfzz dfzz 0.0)) 0 1) (trans (mapcar '+ pt_ins (list dfzz dfzz 0.0)) 0 1) '((0 . "LWPOLYLINE"))) ) (cond ((and ss_pl (> (sslength ss_pl) 1)) (setq tmp (ssadd) l_d nil) (repeat (setq j (sslength ss_pl)) (setq ent_pl (ssname ss_pl (setq j (1- j))) l_d (cons (cons (distance pt_ins (vlax-curve-getClosestPointToProjection ent_pl pt_ins '(0 0 1) nil)) ent_pl ) l_d ) ) ) (ssadd (cdr (assoc (apply 'min (mapcar 'car l_d)) l_d)) tmp) (setq ss_pl tmp) ) ) (acet-ui-progress-safe (setq i (1+ i))) (cond ((and ss_pl (eq (sslength ss_pl) 1)) (setq ent_pl (ssname ss_pl 0) pt (vlax-curve-getClosestPointToProjection ent_pl pt_ins '(0 0 1) nil) prm (vlax-curve-getParamAtPoint ent_pl pt) a_ref (atan (/ (cadr (getvar "ucsxdir")) (car (getvar "ucsxdir")))) deriv (vlax-curve-getfirstderiv ent_pl prm) alpha (if deriv (atan (cadr deriv) (car deriv)) 0.0) alpha (rem (+ (* 2 pi) alpha) (* 2 pi)) alpha (if (and (> (- alpha a_ref) (* 0.5 pi)) (<= (- alpha a_ref) (* pi 1.5))) (+ pi alpha) alpha ) n_ent ent ) (while (/= (cdr (assoc 0 (setq dxf_next (entget (entnext n_ent))))) "SEQEND") (if (eq (cdr (assoc 2 dxf_next)) "ALT") (progn (entmod (subst (cons 50 alpha) (assoc 50 dxf_next) dxf_next ) ) (setq count (1+ count)) ) ) (setq n_ent (cdar dxf_next)) ) ) ) ) (acet-ui-progress) ) ) (princ (strcat "\n" (itoa count) " Blocs TCPOINT ont leur attribut ALT pivoté sur " (itoa (sslength ss)) " sélectionnés.")) (prin1) )

@Kilian336 Effectivement il manquait quelques caractères en fin de code, j'ai rectifié le code dans le post concerné, recharge ce code. Désolé de ce mauvais copié-collé...

@(gile) Exact! J'ai modifié le post initial pour inclure cette robustesse (ligne 6) @didier Je pense que c'est (eval) et (read) qui te perturbe. (read) avec l'exemple va me retourner: (SETQ RSLT (LIST 25.4 12.7 -42)) pour valider la variable RSLT il faut évaluer l'expression, ce à quoi sert la fonction (eval): si rslt n'était pas déclaré en variable locale, !rslt en ligne de commande te renverrai sa valeur. On peut aussi faire cela avec une expression lisp écrite dans un fichier texte avec (read-line) C'est aussi à travers ce procédé que l'on pourrait rendre le lisp "intelligent" (notez les guillemets) pour qu'il écrive sont propre code en construisant ses propres variables selon certaines conditions.

En effet, Ma participation, mais je m'attend à une fonction récursive de ta part. (defun extraireNombres (str / l rslt) (setq l (mapcar '(lambda (x) (if (and (> x 44) (< x 58) (/= x 47)) x 32) ) (vl-string->list str) ) l (mapcar '(lambda (x y) (if (not (= x y 32)) x) ) l (append (cdr l) '(32)) ) l (vl-remove-if-not '(lambda (x) (eq (type x) 'INT) x) l) l (mapcar '(lambda (x) (if (not (eq x 32)) x (list nil))) l) ) (eval (read (strcat "(setq rslt (list " (apply 'strcat (mapcar '(lambda (x) (if (not (listp x)) (chr x) " ")) l)) "))"))) ) (extraireNombres "Longueur = 25.4mm Largeur = 12.7mm Quantité = -42")

Ma proposition! Cela doit tourner les attributs en fonction de la polyligne, en conservant la lecture suivant le scu courant. Tu peux sélectionner l'ensemble des blocs TCPOINT, mais comme le traitement peut être un peu long, j'ai mis une barre de progression. (defun c:test ( / ss dfzz count n progress i ent dxf_ent pt_ins ss_pl ent_pl pt prm a_ref deriv alpha n_ent dxf_next) (setq ss (ssget '((0 . "INSERT") (2 . "TCPOINT")))) (cond (ss (if (not dfzz) (setvar "USERR1" 1E-02)) (initget 4) (if (not (setq dfzz (getdist (strcat "\nRayon de recherche? <" (rtos (getvar "USERR1") 2 2) "> : ")))) (setq dfzz (getvar "USERR1")) (setvar "USERR1" dfzz) ) (setq count 0 progress (setq n (sslength ss)) i 0 ) (acet-ui-progress-init "Progression:" progress) (repeat n (setq ent (ssname ss (setq n (1- n))) dxf_ent (entget ent) pt_ins (cdr (assoc 10 dxf_ent)) ss_pl (ssget "_C" (trans (mapcar '- pt_ins (list dfzz dfzz 0.0)) 0 1) (trans (mapcar '+ pt_ins (list dfzz dfzz 0.0)) 0 1) '((0 . "LWPOLYLINE"))) ) (acet-ui-progress-safe (setq i (1+ i))) (cond ((and ss_pl (eq (sslength ss_pl) 1)) (setq ent_pl (ssname ss_pl 0) pt (vlax-curve-getClosestPointToProjection ent_pl pt_ins '(0 0 1) nil) prm (vlax-curve-getParamAtPoint ent_pl pt) a_ref (atan (/ (cadr (getvar "ucsxdir")) (car (getvar "ucsxdir")))) deriv (vlax-curve-getfirstderiv ent_pl prm) alpha (atan (cadr deriv) (car deriv)) alpha (rem (+ (* 2 pi) alpha) (* 2 pi)) alpha (if (and (> (- alpha a_ref) (* 0.5 pi)) (<= (- alpha a_ref) (* pi 1.5))) (+ pi alpha) alpha ) n_ent ent ) (while (/= (cdr (assoc 0 (setq dxf_next (entget (entnext n_ent))))) "SEQEND") (if (eq (cdr (assoc 2 dxf_next)) "ALT") (progn (entmod (subst (cons 50 alpha) (assoc 50 dxf_next) dxf_next ) ) (setq count (1+ count)) ) ) (setq n_ent (cdar dxf_next)) ) ) ) ) (acet-ui-progress) ) ) (princ (strcat "\n" (itoa count) " Blocs TCPOINT ont leur attribut ALT pivoté sur " (itoa (sslength ss)) "sélectionnés.")) (prin1) )

@didier Rassure toi, j''ai tâtonné avant de trouver cette solution, j'ai essayé d'abord avec l'activeX mais choux blanc: pas de propriété de rotation (dump renvoie une erreur) En observant le comportement des code DXF 10 et 15 lors de rotation j'en ai déduit que je pourrais peut âtre obtenir l'angle. Cela concerne donc bien le bloc, d'ailleurs mon code ne fonctionne pas avec un style de multileader par défaut. La méthode est empirique, mais bon cela répond au besoin ponctuel...

Avec ceci? ((lambda ( / ss ent dxf_ent) (while (not (setq ss (ssget "_+.:E:S" '((0 . "MULTILEADER")))))) (redraw (setq ent (ssname ss 0)) 3) (setq dxf_ent (entget ent)) (print (angtos (angle (cdr (assoc 10 dxf_ent)) (cdr (assoc 15 dxf_ent))) (getvar "AUNITS") 4)) (redraw ent 4) (prin1) ))

@didier Je suis d'accord avec toi que c'est pénible à lire. Mais si je fais comme cela, et que cela permet à ceux qui ne ne sont pas inscrits d'avoir accès au code. Mon but étant le partage, et que n'importe qui peut s'approprier le code et s'en inspirer pour l'améliorer pour répondre à son besoin. Je considère que je ne suis pas un gourou et que je peut faire des erreurs et que des personne puisse les corriger. Merci de m'excuser!

J'ai forcé l'angle à 0.0 et les insertions dans le SCG dans les (entmake): (50 . 0.0) (210 0.0 0.0 1.0) j'ai changé (getint), car les entier sont en effet limité en grandeur; en (getreal) Nouvel version: (defun c:BlockTC_POINTAtt2Vtx ( / js lst_posatt n nb_e ent dxf_ent dxf_210 lst_pt lst_num scl_blk vlaobj pr n_ini n_next old_dmz pt nbs num ang pos_att) (cond ((eq (getvar "cvport") 1) (princ "\n** Commande autorisée uniquement dans l'espace objet.") ) (T (if (not (tblsearch "BLOCK" "TCPOINT")) (progn (entmake '((0 . "BLOCK") (100 . "AcDbEntity") (100 . "AcDbBlockBegin") (2 . "TCPOINT") (70 . 2) (8 . "0") (62 . 256) (6 . "ByLayer") (370 . -2) (10 0.0 0.0 0.0)) ) (entmake '( (0 . "POINT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (100 . "AcDbPoint") (10 0.0 0.0 0.0) (210 0.0 0.0 1.0) (50 . 0.0) ) ) (entmake '( (0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "T_PT_MAT") (100 . "AcDbText") (10 0.25 0.25 0.0) (40 . 0.75) (1 . "") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "STANDARD") (71 . 0) (72 . 0) (11 0.0 0.0 0.0) (210 0.0 0.0 1.0) (100 . "AcDbAttributeDefinition") (280 . 0) (3 . "Matricule") (2 . "MAT") (70 . 0) (73 . 0) (74 . 0) (280 . 1) ) ) (entmake '( (0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "T_PT_ALT") (100 . "AcDbText") (10 0.25 -0.75 0.0) (40 . 0.75) (1 . "") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "STANDARD") (71 . 0) (72 . 0) (11 0.0 0.0 0.0) (210 0.0 0.0 1.0) (100 . "AcDbAttributeDefinition") (280 . 0) (3 . "Altitude") (2 . "ALT") (70 . 0) (73 . 0) (74 . 0) (280 . 1) ) ) (entmake '( (0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "T_PT_COD") (100 . "AcDbText") (10 -0.25 -1.75 0.0) (40 . 0.75) (1 . "code") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "STANDARD") (71 . 0) (72 . 0) (11 0.0 0.0 0.0) (210 0.0 0.0 1.0) (100 . "AcDbAttributeDefinition") (280 . 0) (3 . "CodeSymbole") (2 . "COD") (70 . 0) (73 . 0) (74 . 0) (280 . 1) ) ) (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0") (62 . 256) (6 . "ByLayer") (370 . -2))) ) ) (princ "\nSélectionner les Polylignes où placer à leurs sommets le bloc \"TC_POINT\" avec attributs") (setq js (ssget '((0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>")))) (cond (js (setq lst_posatt '((0.25 0.25 0.0) (0.25 -0.75 0.0) (0.25 -1.75 0.0)) old_dmz (getvar "DIMZIN") ) (setvar "DIMZIN" 0) (repeat (setq n (sslength js)) (setq dxf_ent (entget (setq ent (ssname js (setq n (1- n))))) dxf_210 '(0.0 0.0 1.0) lst_pt nil lst_num nil) (setq vlaobj (vlax-ename->vla-object ent) pr -1 ) (if (not n_next) (progn (initget 5) (setq n_ini (getreal "\nIncrementer en débutant à: ") n_next n_ini) ) (progn (initget "Oui Non _Yes No") (if (eq (getkword "\nRéinitialiser l'incrémentation [Oui/Non] <Non>: ") "Yes") (progn (initget 5) (setq n_ini (getreal "\nIncrementer en débutant à: ") n_next n_ini) ) (setq n_ini n_next) ) ) ) (repeat (setq nb_e (if (zerop (vlax-get vlaobj 'Closed)) (1+ (fix (vlax-curve-getEndParam vlaobj))) (fix (vlax-curve-getEndParam vlaobj)))) (setq pt (vlax-curve-GetPointAtParam vlaobj (setq pr (1+ pr))) lst_pt (cons pt lst_pt) lst_num (cons n_next lst_num) ) (if (not scl_blk) (progn (initget 7) (setq scl_blk (getdist (trans pt 0 1) "\nEchelle du bloc?: ")))) (setq n_next (+ 2.0 n_ini) n_ini n_next) ) (setq nbs (1- (length lst_pt))) (foreach pto lst_pt (setq num (car lst_num) ang 0.0 pos_att (mapcar '(lambda (x) (polar (trans '(0.0 0.0 0.0) dxf_210 0) (+ (angle (trans '(0.0 0.0 0.0) dxf_210 0) (trans x dxf_210 0)) ang) (distance (trans '(0.0 0.0 0.0) dxf_210 0) (trans x dxf_210 0)))) (mapcar '(lambda (y) (mapcar '(lambda (x) (* scl_blk x)) y)) lst_posatt)) nbs (1- nbs) ) (entmake (append '( (0 . "INSERT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (100 . "AcDbBlockReference") (66 . 1) (2 . "TCPOINT") ) (list (cons 41 scl_blk) (cons 42 scl_blk) (cons 43 scl_blk) ) '( (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) (50 . 0.0) ) (list (cons 10 pto) (cons 210 '(0.0 0.0 1.0))) ) ) (entmake (append '( (0 . "ATTRIB") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "T_PT_MAT") (100 . "AcDbText") (50 . 0.0) ) (list (cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210)) (cons 1 (rtos num 2 0)) (cons 40 scl_blk) ) '( (41 . 1.0) (51 . 0.0) (7 . "STANDARD") (71 . 0) (72 . 0) (11 0.0 0.0 0.0) ) (list (cons 210 dxf_210) ) '( (100 . "AcDbAttribute") (2 . "MAT") (70 . 0) (73 . 0) (74 . 0) ) ) ) (setq pos_att (cdr pos_att)) (entmake (append '( (0 . "ATTRIB") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "T_PT_ALT") (100 . "AcDbText") (50 . 0.0) ) (list (cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210)) (cons 1 (rtos (caddr pto) 2 2)) (cons 40 scl_blk) ) '( (41 . 1.0) (51 . 0.0) (7 . "STANDARD") (71 . 0) (72 . 0) (11 0.0 0.0 0.0) ) (list (cons 210 dxf_210) ) '( (100 . "AcDbAttribute") (2 . "ALT") (70 . 0) (73 . 0) (74 . 0) ) ) ) (setq pos_att (cdr pos_att)) (entmake (append '( (0 . "ATTRIB") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "T_PT_COD") (100 . "AcDbText") (50 . 0.0) ) (list (cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210)) (cons 1 (strcat "\"" (cdr (assoc 5 dxf_ent)) "\"")) (cons 40 scl_blk) ) '( (41 . 1.0) (51 . 0.0) (7 . "STANDARD") (71 . 0) (72 . 0) (11 0.0 0.0 0.0) ) (list (cons 210 dxf_210) ) '( (100 . "AcDbAttribute") (2 . "COD") (70 . 0) (73 . 0) (74 . 0) ) ) ) (entmake '((0 . "SEQEND") (62 . 256) (6 . "ByLayer") (370 . -2))) (setq lst_num (cdr lst_num)) ) (princ (strcat "\n" (itoa nb_e) " blocs \"TC_POINT\" placés et renseignés.")) ) (setvar "DIMZIN" old_dmz) ) (T (princ "\nSélection non valide ou vide.")) ) ) ) (prin1) )

Salut, Est ce que ceci pourrait faire l'affaire? Tu peux geler les calques "T_PT_ALT" et "T_PT_COD" pour avoir que la numérotation. (defun c:BlockTC_POINTAtt2Vtx ( / js lst_posatt n nb_e ent dxf_ent dxf_210 lst_pt lst_num scl_blk vlaobj pr n_ini n_next old_dmz pt nbs num ang pos_att) (cond ((eq (getvar "cvport") 1) (princ "\n** Commande autorisée uniquement dans l'espace objet.") ) (T (if (not (tblsearch "BLOCK" "TCPOINT")) (progn (entmake '((0 . "BLOCK") (100 . "AcDbEntity") (100 . "AcDbBlockBegin") (2 . "TCPOINT") (70 . 2) (8 . "0") (62 . 256) (6 . "ByLayer") (370 . -2) (10 0.0 0.0 0.0)) ) (entmake '( (0 . "POINT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (100 . "AcDbPoint") (10 0.0 0.0 0.0) (210 0.0 0.0 1.0) (50 . 0.0) ) ) (entmake '( (0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "T_PT_MAT") (100 . "AcDbText") (10 0.25 0.25 0.0) (40 . 0.75) (1 . "") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "STANDARD") (71 . 0) (72 . 0) (11 0.0 0.0 0.0) (210 0.0 0.0 1.0) (100 . "AcDbAttributeDefinition") (280 . 0) (3 . "Matricule") (2 . "MAT") (70 . 0) (73 . 0) (74 . 0) (280 . 1) ) ) (entmake '( (0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "T_PT_ALT") (100 . "AcDbText") (10 0.25 -0.75 0.0) (40 . 0.75) (1 . "") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "STANDARD") (71 . 0) (72 . 0) (11 0.0 0.0 0.0) (210 0.0 0.0 1.0) (100 . "AcDbAttributeDefinition") (280 . 0) (3 . "Altitude") (2 . "ALT") (70 . 0) (73 . 0) (74 . 0) (280 . 1) ) ) (entmake '( (0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "T_PT_COD") (100 . "AcDbText") (10 -0.25 -1.75 0.0) (40 . 0.75) (1 . "code") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "STANDARD") (71 . 0) (72 . 0) (11 0.0 0.0 0.0) (210 0.0 0.0 1.0) (100 . "AcDbAttributeDefinition") (280 . 0) (3 . "CodeSymbole") (2 . "COD") (70 . 0) (73 . 0) (74 . 0) (280 . 1) ) ) (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0") (62 . 256) (6 . "ByLayer") (370 . -2))) ) ) (princ "\nSélectionner les Polylignes où placer à leurs sommets le bloc \"TC_POINT\" avec attributs") (setq js (ssget '((0 . "*POLYLINE") (-4 . "<NOT") (-4 . "&") (70 . 112) (-4 . "NOT>")))) (cond (js (setq lst_posatt '((0.25 0.25 0.0) (0.25 -0.75 0.0) (0.25 -1.75 0.0)) old_dmz (getvar "DIMZIN") ) (setvar "DIMZIN" 0) (repeat (setq n (sslength js)) (setq dxf_ent (entget (setq ent (ssname js (setq n (1- n))))) dxf_210 (cdr (assoc 210 dxf_ent)) lst_pt nil lst_num nil) (setq vlaobj (vlax-ename->vla-object ent) pr -1 ) (if (not n_next) (progn (initget 1) (setq n_ini (getint "\nIncrementer en débutant à: ") n_next n_ini) ) (progn (initget "Oui Non _Yes No") (if (eq (getkword "\nRéinitialiser l'incrémentation [Oui/Non] <Non>: ") "Yes") (progn (initget 1) (setq n_ini (getint "\nIncrementer en débutant à: ") n_next n_ini) ) (setq n_ini n_next) ) ) ) (repeat (setq nb_e (if (zerop (vlax-get vlaobj 'Closed)) (1+ (fix (vlax-curve-getEndParam vlaobj))) (fix (vlax-curve-getEndParam vlaobj)))) (setq pt (vlax-curve-GetPointAtParam vlaobj (setq pr (1+ pr))) lst_pt (cons pt lst_pt) lst_num (cons n_next lst_num) ) (if (not scl_blk) (progn (initget 7) (setq scl_blk (getdist (trans pt 0 1) "\nEchelle du bloc?: ")))) (setq n_next (+ 2 n_ini) n_ini n_next) ) (setq nbs (1- (length lst_pt))) (foreach pto lst_pt (setq num (car lst_num) ang (if (and (not (zerop nbs)) (not (eq (1+ nbs) (length lst_pt)))) (- (* 0.5 (+ (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj (1- nbs))) (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj nbs)) ) ) (* 0.5 pi) ) (+ (* 0.5 pi) (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj nbs))) ) ang (if (and (> ang (* 0.5 pi)) (<= ang (* pi 1.5))) (+ pi ang) ang) pos_att (mapcar '(lambda (x) (polar (trans '(0.0 0.0 0.0) dxf_210 0) (+ (angle (trans '(0.0 0.0 0.0) dxf_210 0) (trans x dxf_210 0)) ang) (distance (trans '(0.0 0.0 0.0) dxf_210 0) (trans x dxf_210 0)))) (mapcar '(lambda (y) (mapcar '(lambda (x) (* scl_blk x)) y)) lst_posatt)) nbs (1- nbs) ) (entmake (append '( (0 . "INSERT") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (100 . "AcDbBlockReference") (66 . 1) (2 . "TCPOINT") ) (list (cons 41 scl_blk) (cons 42 scl_blk) (cons 43 scl_blk) ) '( (70 . 0) (71 . 0) (44 . 0.0) (45 . 0.0) ) (list (cons 50 ang) (cons 10 (trans pto 0 dxf_210)) (cons 210 dxf_210)) ) ) (entmake (append '( (0 . "ATTRIB") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "T_PT_MAT") (100 . "AcDbText") ) (list (cons 50 ang) (cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210)) (cons 1 (itoa num)) (cons 40 scl_blk) ) '( (41 . 1.0) (51 . 0.0) (7 . "STANDARD") (71 . 0) (72 . 0) (11 0.0 0.0 0.0) ) (list (cons 210 dxf_210) ) '( (100 . "AcDbAttribute") (2 . "MAT") (70 . 0) (73 . 0) (74 . 0) ) ) ) (setq pos_att (cdr pos_att)) (entmake (append '( (0 . "ATTRIB") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "T_PT_ALT") (100 . "AcDbText") ) (list (cons 50 ang) (cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210)) (cons 1 (rtos (caddr pto) 2 2)) (cons 40 scl_blk) ) '( (41 . 1.0) (51 . 0.0) (7 . "STANDARD") (71 . 0) (72 . 0) (11 0.0 0.0 0.0) ) (list (cons 210 dxf_210) ) '( (100 . "AcDbAttribute") (2 . "ALT") (70 . 0) (73 . 0) (74 . 0) ) ) ) (setq pos_att (cdr pos_att)) (entmake (append '( (0 . "ATTRIB") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "T_PT_COD") (100 . "AcDbText") ) (list (cons 50 ang) (cons 10 (trans (list (+ (car pto) (caar pos_att)) (+ (cadr pto) (cadar pos_att)) (+ (caddr pto) (caddar pos_att))) 0 dxf_210)) (cons 1 (strcat "\"" (cdr (assoc 5 dxf_ent)) "\"")) (cons 40 scl_blk) ) '( (41 . 1.0) (51 . 0.0) (7 . "STANDARD") (71 . 0) (72 . 0) (11 0.0 0.0 0.0) ) (list (cons 210 dxf_210) ) '( (100 . "AcDbAttribute") (2 . "COD") (70 . 0) (73 . 0) (74 . 0) ) ) ) (entmake '((0 . "SEQEND") (62 . 256) (6 . "ByLayer") (370 . -2))) (setq lst_num (cdr lst_num)) ) (princ (strcat "\n" (itoa nb_e) " blocs \"TC_POINT\" placés et renseignés.")) ) (setvar "DIMZIN" old_dmz) ) (T (princ "\nSélection non valide ou vide.")) ) ) ) (prin1) )

Bonjour, Je soupçonne un zoom total au lieu d'un zoom étendu ... Comment est-il lancé, ça je n'en sais rien: un lisp chargé automatiquement ? Est ce que un zoom total après un zoom étendu te ramène à perpète? Si c'est le cas tu peut redéfinir les LIMITES du dessin qui pose problème sans les rendre actifs (car cela peut être gênant pour l'insertion d'XREF au point d'origine) Ou trouver la procédure coupable!

Bonjour, @drault Peut être un problème avec les MultiTextes, en effet on peut forcer un style de texte sur tout ou une partie du texte dans l'éditeur indépendamment du style courant du MText. Si c'est le cas il sera impossible de purger ce style sans intervenir dans l'éditeur. Un outil qui peut aider à enlever les formatage forcés dans l'éditeur est d'utiliser le lisp StripMtext et je pense qu'ensuite le style pourra être purgé.

Désolé, j'avais mal lu ta demande: je croyais que tu voulais au contraire un masque... Pour faire l'inverse mets simplement 0 à la place de -1

Bonjour, Tu pourrais ajouter à la fin de ta macro cette instruction: (vlax-put (vlax-ename->vla-object (entlast)) 'BackgroundFill -1)

Alors avec un LT 2024 ou plus, on peut envisager ce code lisp. Exemple d'utilisation: (dimattach 1) -> enlève les lignes d'attaches de la cotation sélectionnée (dimattach 0) -> remet les lignes d'attaches de la cotation sélectionnée Ces instructions pourraient être mises dans un bouton... (defun dimattach (b / ss elst xd) (cond ((and (eq (type b) 'INT) (or (zerop b) (eq b 1))) (princ "\nSélectioner une cotation.") (while (setq ss (ssget "_+.:E:S" '((0 . "DIMENSION")))) (setq elst (entget (ssname ss 0) '("ACAD")) xd (assoc -3 elst) ) (entmod (append (if xd (entget (ssname ss 0)) elst) (list (list -3 (cons "ACAD" (list (cons 1000 "DSTYLE") (cons 1002 "{") (cons 1070 76) (cons 1070 b) (cons 1070 75) (cons 1070 b) (cons 1002 "}") ) ) ) ) ) ) (princ "\nSélectioner une cotation.") ) ) (T (princ "\nLa fonction requiert l'argument entier 1 ou 0 ")) ) (prin1) )

Bonjour, J'avais rencontrer un problème avec les listes d'échelles. J'avais remarqué que si l'on employait une échelle précise et qu'une procédure effaçait toutes les listes d'échelles pour recréer une liste établie selon nos goûts, et bien même si l'échelle précise employée était recréée à l'identique cela mettait le binz... Cela vient en fait que l'identifiant dans les dictionnaires n'est plus le même après avoir recréé l'échelle identique, l'annotativité de l'objet déjà établie ne retrouve plus sa définition dans le dictionnaire. Je ne sais pas si dans les versions récentes, cela est toujours le cas, mais je pense que oui. A mon avis il faudrait éviter d'effacer les échelles déjà employés dans le dessin. J'avais évoqué le problème ICI Ces informations vous seront-elles utiles ?

Bonsoir Bruno, C'est marrant de se congratuler entre Bruno!... Pour ta fonction, il est sur que si tu limites aux nombres entier tu atteint vite les limites de puissance de calcul. Pour te dire, je m'étais penché sur les factorielles dans les années 80 pour programmer des clothoïdes... A l'époque (comme Denis H.) je ne comprenais rien aux fonctions récursives. AutoDesk pour la version R12 donnait un exemple de fonction récursive pour une factorielle. Fonction (fact) et (factor). Je l'ai donc utilisé pour calculer une clothoïde unitaire selon la formule de Fresnel. La fonction (trace) m'a été très utile pour appréhender cette fonction récursive. Sur les machine à 32 bits de l'époque (fact 69) était la limite supérieure de calcul. Depuis je n'ai pas re-testé les nouvelles limites sur les machine 64 bits. Pour le fun: voici mon code de la clothoïde unitaire (soyez indulgent c'est un code des années 80...) (defun desclo (lst / pl dl) (setq pl lst dl (length pl)) (command "_.pline") (repeat dl (command (car pl)) (setq pl (cdr pl)) ) (command "") (command "_.pedit" (entlast) "_fit" "") ) (defun factor (y / ) (cond ((= 0 y) 1) (t (* y (factor (1- y)))) ) ) (defun fact (nbr / x) (setq x nbr) (factor (float x)) ) (defun serie (rep / resul mark rp) (setq mark 1 rp rep som 0) (repeat (fix (* l 10)) (setq resul (/ (expt tau rp) (* (1+ (* 2 rp)) (fact rp)))) (if (/= (rem mark 2) 0) (setq resul (- resul)) ) (setq som (+ resul som) rp (+ rp 2) mark (1+ mark)) ) ) (defun c:cloun () (setvar "cmdecho" 0) (setvar "osmode" (+ 16384 (rem (getvar "osmode") 16384))) (setq l (/ (sqrt pi) 10) lst '((0.0 0.0)) tsl ()) (while (<= l (* 4.5 (sqrt pi))) (setq r (/ 1 l) tau (/ (* l l) 2) k (sqrt (* 2 tau))) (serie 2) (setq x (* k (+ 1 som))) (serie 3) (setq y (* k (+ (/ tau 3) som)) xm (- x (* r (sin tau))) ym (+ y (* r (cos tau))) dltr (- ym r) taug (/ (* tau 200) pi) taud (/ (* tau 180) pi)) (prompt "\ntau en grade : ") (prin1 (rtos taug 2 0)) (prompt "\ntau en degre : ") (prin1 (rtos taud 2 2)) (prompt "\nl longueur : ") (prin1 (rtos l 2 4)) (prompt "\nr rayon : ") (prin1 (rtos r 2 4)) (prompt "\ndelta r : ") (prin1 (rtos dltr 2 4)) (prompt "\nxM : ") (prin1 (rtos xm 2 4)) (prompt "\nyM : ") (prin1 (rtos ym 2 4)) (prompt "\nx : ") (prin1 (rtos x 2 4)) (prompt "\ny : ") (prin1 (rtos y 2 4)) (prompt "\n------------------------------------------") ;(grread) (setq l (+ l (/ (sqrt pi) 10))) (setq lst (cons (cons x (cons y ())) lst)) (setq tsl (cons (cons xm (cons ym ())) tsl)) ) (command "_.layer" "_make" "clo" "_color" "3" "" "") (desclo lst) (command "_.layer" "_make" "centre" "_color" "6" "" "") (desclo tsl) (prin1) )

Bonjour Bruno, Jusqu'à (fact 12) le résultat est correct, mais après cet entier le retour est faux