bonuscad

C'est pas l'hébergeur en cause, mais le lien généré. Le bon lien de l'image de rimbo ICI Autrement ma suggestion (à adapter) Un fichier .LIN contenant: *T2,longitudinale de rive A,1.5000,-0.875,["T2",STANDARD,S=0.3,R=0.0,X=-0.25,Y=-0.15],-0.875 Appliquer le type de ligne à une polyligne à laquelle vous mettrez une épaisseur constante de 0.3

Bonjour, En faisant un fichier CSV par exemple. Peut être faudra t-il encore ajuster le code pour avoir exactement ce que tu veux. (defun c:dim2csv ( / js dxf_cod mod_sel n lremov file_name cle f_open key_sep str_sep oldim ename l_pt) (princ "\nChoix d'un objet modèle pour le filtrage: ") (while (null (setq js (ssget "_+.:E:S" (list '(0 . "DIMENSION") (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 valable pour cette fonction!") ) (vl-load-com) (setq dxf_cod (entget (ssname js 0))) (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)) ) (initget "Unique Tout Manuel _Single All Manual") (if (not (eq (setq mod_sel (getkword "\nMode de sélection filtrée, choix [unique/Tout/Manuel]<Manuel>: ")) "Single")) (if (eq mod_sel "All") (setq js (ssget "_X" dxf_cod)) (setq js (ssget dxf_cod)) ) ) (setq file_name (getfiled "Nom du fichier a créer ?: " (strcat (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 3)) "csv") "csv" 37)) (if (null file_name) (exit)) (if (findfile file_name) (progn (prompt "\nFichier éxiste déjà!") (initget "Ajoute Remplace annUler _Add Replace Undo") (setq cle (getkword "\nDonnées dans fichier? [Ajouter/Remplacer/annUler] <R>: ") ) (cond ((eq cle "Add") (setq cle "a") ) ((or (eq cle "Replace") (eq cle ())) (setq cle "w") ) (T (exit)) ) (setq f_open (open file_name cle)) ) (setq f_open (open file_name "w")) ) (initget "Espace Virgule Point-virgule Tabulation _SPace Comma SEmicolon Tabulation") (setq key_sep (getkword "\nSéparateur [Espace/Virgule/Point-virgule/Tabulation]? <Point-virgule>: ")) (cond ((eq key_sep "SPpace") (setq str_sep " ")) ((eq key_sep "Comma") (setq str_sep ",")) ((eq key_sep "Tabulation") (setq str_sep "\t")) (T (setq str_sep ";")) ) ; (setq str_sep (vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (setq oldim (getvar "dimzin")) (setvar "dimzin" 0) (write-line (strcat "Type" str_sep "Longueur") f_open) (repeat (setq n (sslength js)) (setq ename (vlax-ename->vla-object (ssname js (setq n (1- n)))) l_pt nil) (if (vlax-property-available-p ename 'Measurement) (setq l_pt (cons (cons (vlax-get ename 'TextOverride) (vlax-get ename 'Measurement)) l_pt)) ) (foreach n l_pt (write-line (strcat (car n) str_sep (rtos (cdr n) 2 2)) f_open) ) ) (close f_open) (setvar "dimzin" oldim) (prin1) )

??? Dans le dernier code posté: Fais ce que tu demandes. Quand je l'applique à ton dessin test, j'obtiens le même formatage des nombres que celui fait dans le dessin. Si c'est vraiment des millimètres que tu veux (alors que ton dessin à l'air en mètres) (strcat "N "(rtos (* 1000.0 (cadar x)) 2 3) "\\PE " (rtos (* 1000.0 (caar x)) 2 3)) rtos (Real TO String) formate un nombre réel suivant le système d'unité et la précision demandé (si ceux-ci sont fournis, autrement c'est les valeur courante du dessin): (rtos réel mode précision)

ICI

Quand on a des demandes si spécifiques, je pense qu'il serait bien se s'y pencher un peu... Néanmoins le code basique, à toi de fignoler si besoin! (vl-load-com) (defun z_dir (p1 p2 / ) (trans '(0.0 1.0 0.0) (mapcar '(lambda (k) (/ k (sqrt (apply '+ (mapcar '(lambda (x) (* x x)) (mapcar '- p2 p1) ) ) ) ) ) (mapcar '- p2 p1) ) 0 ) ) (defun c:peigne ( / js dxf_obj obj_vlax pt_start pt_end total_dist partial_dist ori_dist tooth lst_pt increment_dist ang dxf_210 lnw_pt) (princ "\nSélectionner un objet curviligne à mesurer: ") (while (not (setq js (ssget "_+.:E:S" (list (cons 0 "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE") (cons 67 (if (eq (getvar "CVPORT") 2) 0 1)) (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB"))) (cons -4 "<NOT") (cons -4 "&") (cons 70 112) (cons -4 "NOT>") ) ) ) ) (princ "\nCe n'est pas un objet curviligne valable pour cette fonction!") ) (setq dxf_obj (entget (ssname js 0)) obj_vlax (vlax-ename->vla-object (ssname js 0)) pt_start (vlax-curve-getStartPoint obj_vlax) pt_end (vlax-curve-getEndPoint obj_vlax) total_dist (vlax-curve-getDistAtParam obj_vlax (vlax-curve-getEndParam obj_vlax)) ) (initget 6) (setq partial_dist (getdist "\nEntrez la distance partielle <20.0>: ")) (if (not partial_dist) (setq partial_dist 20.0)) (setq ori_dist 0.0 increment_dist 0.0) (cond ((> total_dist partial_dist) (initget 6) (setq tooth (getdist "\nEntrez une nouvelle distance de peigne <7.5>: ")) (if (not tooth) (setq tooth 7.5)) (setq lst_pt (list pt_start)) (while (< increment_dist total_dist) (setq lst_pt (cons (vlax-curve-getPointAtDist obj_vlax increment_dist) lst_pt) increment_dist (+ increment_dist partial_dist) ) ) (setq lst_pt (reverse (cons pt_end lst_pt)) lnw_pt nil) (foreach n lst_pt (setq ang (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv obj_vlax (vlax-curve-getParamAtPoint obj_vlax n))) dxf_210 (z_dir n (polar n ang (* 0.1 partial_dist))) ) (setq lnw_pt (cons (list (polar (trans n 0 dxf_210) (+ (/ pi 2) ang) tooth) (polar (trans n 0 dxf_210) (- ang (/ pi 2)) tooth) ) lnw_pt ) ) ) (mapcar '(lambda (x) (vla-addMtext (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) ) (vlax-3d-point (polar (car x) (* pi 0.5) (getvar "TEXTSIZE"))) 0.0 (strcat "N "(rtos (cadar x) 2 3) "\\PE " (rtos (caar x) 2 3)) ) (vla-addMtext (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) ) (vlax-3d-point (polar (cadr x) (* pi 0.5) (getvar "TEXTSIZE"))) 0.0 (strcat "N "(rtos (cadadr x) 2 3) "\\PE " (rtos (caadr x) 2 3)) ) ) lnw_pt ) ) (T (princ "\nLa longueur est trop grande pour l'objet!")) ) (prin1) )

Bonjour, J'avais publié déjà ici la même chose avec Z Max J'adapte pour Z min (en rajoutant un point au sommet concerné sur chaque polyligne3D ) (vl-load-com) (defun c:min_z ( / js obj ename pr pt lst_pt lst_z id_seg nw_pt) (princ "\nSelectionner les polyligne3D: ") (while (null (setq js (ssget '((0 . "POLYLINE") (-4 . "&") (70 . 8))))) (princ "\nObjets non valable!") ) (repeat (setq n (sslength js)) (setq obj (ssname js (setq n (1- n))) ename (vlax-ename->vla-object obj) pr -1 ) (repeat (if (zerop (vlax-get ename 'Closed)) (1+ (fix (vlax-curve-getEndParam ename))) (fix (vlax-curve-getEndParam ename))) (setq pt (vlax-curve-GetPointAtParam ename (setq pr (1+ pr))) lst_pt (cons pt lst_pt) ) ) (setq lst_z (mapcar 'caddr lst_pt) id_seg (- (length lst_z) (length (member (apply 'min lst_z) lst_z))) ) (setq nw_pt (vlax-invoke (if (eq (getvar "CVPORT") 1) (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) ) 'AddPoint (nth id_seg lst_pt) ) ) (vla-put-Normal nw_pt (vlax-3d-point '(0 0 1))) ) (prin1) )

Je n'ai pas de soucis J'ai édité le code en #3 où j'ai modifié les valeur par défauts et j'ai rajouté une ligne commentée pour te prouver que cela fonctionne. (il te suffit de la dé-commenter; enlever le semi-colon, pour qu'il trace le peigne) Cette ligne commentée peut être remplacer par une autre action (inscrire les coordonnées?, insérer un bloc?), tu as les points de définitions (la liste lnw_pt), à toi d'en faire ce que tu veux... moi je t'ai donné le principe.

Le lien ne mène à rien...., j'ouvre simplement une copie sur mon disque de ta page de téléchargement sur free

Dans mon code, j'ai partial_dist 1000.0 (pour déterminer les points kilométrique tout les 1000 mètres) Si tu veux déterminer tous les 0+020, il te faut simplement mettre partial_dist 20.0 Bien sur dans ce cas tu ne pourra exécuter le code que sur des objets supérieur à 20m.

C'est ta sélection d'objet qui n'est pas achevée et tes parenthèses mal appariées. (command "_.change" (ssget "_X" '((0 . "*TEXT") (8 . "moncalque"))) "" "_properties" "_color" "7" "")

J'avais bien compris; les coordonnées de chaque extrémités du peigne. En épurant le code dans le lien donné pour avoir les coordonnée (par paire dans la liste lnw_pt) (vl-load-com) (defun z_dir (p1 p2 / ) (trans '(0.0 1.0 0.0) (mapcar '(lambda (k) (/ k (sqrt (apply '+ (mapcar '(lambda (x) (* x x)) (mapcar '- p2 p1) ) ) ) ) ) (mapcar '- p2 p1) ) 0 ) ) (defun c:peigne ( / js dxf_obj obj_vlax pt_start pt_end total_dist partial_dist ori_dist tooth lst_pt increment_dist ang dxf_210 lnw_pt) (princ "\nSélectionner un objet curviligne à mesurer: ") (while (not (setq js (ssget "_+.:E:S" (list (cons 0 "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE") (cons 67 (if (eq (getvar "CVPORT") 2) 0 1)) (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB"))) (cons -4 "<NOT") (cons -4 "&") (cons 70 112) (cons -4 "NOT>") ) ) ) ) (princ "\nCe n'est pas un objet curviligne valable pour cette fonction!") ) (setq dxf_obj (entget (ssname js 0)) obj_vlax (vlax-ename->vla-object (ssname js 0)) pt_start (vlax-curve-getStartPoint obj_vlax) pt_end (vlax-curve-getEndPoint obj_vlax) total_dist (vlax-curve-getDistAtParam obj_vlax (vlax-curve-getEndParam obj_vlax)) ) (initget 6) (setq partial_dist (getdist "\nEntrez la distance partielle <20.0>: ")) (if (not partial_dist) (setq partial_dist 20.0)) (setq ori_dist 0.0 increment_dist 0.0) (cond ((> total_dist partial_dist) (initget 6) (setq tooth (getdist "\nEntrez une nouvelle distance de peigne <7.5>: ")) (if (not tooth) (setq tooth 7.5)) (setq lst_pt (list pt_start)) (while (< increment_dist total_dist) (setq lst_pt (cons (vlax-curve-getPointAtDist obj_vlax increment_dist) lst_pt) increment_dist (+ increment_dist partial_dist) ) ) (setq lst_pt (reverse (cons pt_end lst_pt)) lnw_pt nil) (foreach n lst_pt (setq ang (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv obj_vlax (vlax-curve-getParamAtPoint obj_vlax n))) dxf_210 (z_dir n (polar n ang (* 0.1 partial_dist))) ) (setq lnw_pt (cons (list (polar (trans n 0 dxf_210) (+ (/ pi 2) ang) tooth) (polar (trans n 0 dxf_210) (- ang (/ pi 2)) tooth) ) lnw_pt ) ) ) (print lnw_pt) ;(mapcar '(lambda (x) (command "_.line" "_none" (car x) "_none" (cadr x) "")) lnw_pt) ) (T (princ "\nLa longueur est trop grande pour l'objet!")) ) (prin1) )

Alors ce serait plus proche de ce genre de fonction ? -> mesure_PK.lsp Ici tout sera dessiné et noté, mais le mode de fonctionnement peut être modifié.

Bonjour, Passer du motif SOLID à un motif par trait n'est pas le plus aisé en DXF. En effet le motif SOLID a une définition plus proche du motif "gradient" ou même des MPOLYGON de map. Dans ce motif il n'y a pas de notion d'échelle ou d'orientation, par contre d'autre code sont utilisés. Je pense pas que (entmod) soit le plus approprié pour faire ce que tu désire, car la structure des élément doit être rigoureuse pour que cela fonctionne. Peut être comme ceci cela pourrait fonctionner; pas testé outre mesure. (defun c:all2ansi (/ ss n elst lremov) (setq ss (ssget "_X" '((0 . "HATCH") (2 . "SOLID")))) (repeat (setq n (sslength ss)) (setq elst (entget (ssname ss (setq n (1- n))))) (setq elst (subst '(2 . "ANSI31") '(2 . "SOLID") elst)) (setq elst (subst '(70 . 1) '(70 . 0) elst)) (setq lremov nil) (foreach n elst (if (member (car n) '(450 451 460 461 452 462 453 463 63 421 463 63 421 470)) (setq lremov (cons (car n) lremov)))) (foreach m lremov (setq elst (vl-remove (assoc m elst) elst)) ) (setq elst (append elst '((52 . 0) (41 . 1.0) (77 . 0) (78 . 1) (53 . 0.785398) (43 . 0.0) (44 . 0.0) (45 . -0.224506) (46 . 0.224506) (79 . 0)))) (entmod elst) ) (princ) )

Bonjour, Tu peux essayer de "bricoler" ma réponse faite ici Au lieu d’exécuter les dernières lignes pour dessiner la polyligne: (setq nw_pl (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar 'list (mapcar 'car l_pt) (mapcar 'cadr l_pt))))) (vla-put-Closed nw_pl 1) Tu utilise la liste l_pt pour récupérer les points de définitions.

Bonjour, Pour moi qui suis sous une version 2011 (setpropertyvalue bl "DATE_DE_L'OFFRE" "Nouvelle Date") ne fonctionne pas, alors qu'avec la ligne suivante à la place j'arrive à modifier l'attribut (vla-put-TextString (car (vlax-invoke (vlax-ename->vla-object bl) 'GetAttributes)) "Nouvelle Date") Bon je n'ai fais qu'un attribut, je n'ai pas testé avec plusieurs... En fin de compte, avec plusieurs, il faudrait plutôt ceci (foreach el (vlax-invoke (vlax-ename->vla-object bl) 'GetAttributes) (if (eq (vla-get-TagString el) "DATE_DE_L'OFFRE") (vla-put-TextString el "Nouvelle Date") ) )

Pour inclure la sélection Implicite ou Précédente, ce n'est pas bien difficile a intégrer au code! Je me suis aussi aperçu que tu as aussi sollicité de l'aide sur des forum anglophone, ce qui n'a pas motivé une réponse rapide de ma part et ce qui me fais penser que tu ne cherche pas à construire mais avoir une réponse prête à l'emploi. Bon voici malgré tout la petite modification incluse dans le code complet. (defun c:test ( / js js_all n fence js_ins nb) (princ "\nSélectionnez les polylignes: ") (or (setq js (ssget "_I" '((0 . "LWPOLYLINE")))) (setq js (ssget "_P" '((0 . "LWPOLYLINE")))) ) (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 '((0 . "LWPOLYLINE")))) ) ) (setq js_all (ssadd)) (cond (js (repeat (setq n (sslength js)) (setq fence (listpol (ssname js (setq n (1- n)))) js_ins (ssget "_F" fence '((0 . "INSERT"))) ) (cond (js_ins (repeat (setq nb (sslength js_ins)) (ssadd (ssname js_ins (setq nb (1- nb))) js_all) ) ) ) ) (sssetfirst nil js_all) ) ) (prin1) ) ;;; listpol by Gille Chanteau ; ;;; Returns the vertices list of any type of polyline (WCS coordinates) ; ;;; ; ;;; Argument ; ;;; en, a polyline (ename or vla-object) ; (defun listpol (en / i p l) (setq i (if (vlax-curve-IsClosed en) (vlax-curve-getEndParam en) (+ (vlax-curve-getEndParam en) 1) ) ) (while (setq p (vlax-curve-getPointAtParam en (setq i (1- i)))) (setq l (cons (trans p 0 1 ) l)) ) )

Bonjour, J'ai pas trop testé..., surtout dans des SCU Cela devrait fonctionner avec des polylignes légères (LWPOLYLINE) qui ne comporte pas d'arc. Pour les pentes, fournir un réel, par exemple pour 15.25% taper 15.25 (vl-load-com) (defun draw_pt (pt col / rap) (setq rap (/ (getvar "viewsize") 50)) (foreach n (mapcar '(lambda (x) (list ((eval (car x)) (car pt) rap) ((eval (cadr x)) (cadr pt) rap) (caddr pt) ) ) '((+ +) (+ -) (- +) (- -)) ) (grdraw pt n col) ) ) (defun c:lwpolto3d ( / js ent AcDoc Space vlaobj perim_obj loop q_dep pt_start z_start z_end k_z l_pt nwl_pt flag) (princ "\nSélectionner la polyligne légère à convertir en 3D: ") (while (not (setq js (ssget "_+.:E:S" (list (cons 0 "LWPOLYLINE") (cons 67 (if (eq (getvar "CVPORT") 2) 0 1)) (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB"))) ) ) ) ) ) (redraw (setq ent (ssname js 0)) 3) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (eq (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) vlaobj (vlax-ename->vla-object ent) perim_obj (vlax-curve-getDistAtParam vlaobj (vlax-curve-getEndParam vlaobj)) loop 1 ) (draw_pt (setq pt_start (trans (vlax-curve-getStartPoint vlaobj) 0 1)) 1) (initget "Autre _Other") (while (eq (setq q_dep (getkword "\nChoisir l'autre extrémité comme point de départ? [Autre]: ")) "Other") (redraw) (draw_pt (setq pt_start (trans (if (zerop (rem (setq loop (1+ loop)) 2)) (vlax-curve-getEndPoint vlaobj) (vlax-curve-getStartPoint vlaobj)) 0 1)) 1) (initget "Autre _Other") ) (redraw) (initget 1) (setq z_start (getreal "\nAltitude de départ de l'extrémité sélectionnée?: ")) (initget 1 "Pente _Slope") (setq z_end (getreal "\nAltitude de fin de l'autre extrémité ou [Pente]?: ")) (if (eq z_end "Slope") (progn (initget 1) (setq z_end (getreal "\nPente (valeur en %) désirée?: ") z_end (+ z_start (* perim_obj (/ z_end 100.0))) ) ) ) (setq k_z (/ (- z_end z_start) perim_obj) l_pt (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget ent))) nwl_pt nil ) (redraw ent 4) (if (not (equal (list (car pt_start) (cadr pt_start)) (car l_pt))) (setq l_pt (reverse l_pt) flag T) (setq flag nil)) (foreach el l_pt (setq nwl_pt (cons (append el (list (+ z_start (* k_z (if flag (- perim_obj (vlax-curve-getDistAtPoint vlaobj el)) (vlax-curve-getDistAtPoint vlaobj el)))))) nwl_pt)) ) (vlax-invoke Space 'Add3DPoly (apply 'append (reverse nwl_pt))) (prin1) )

Tu n'es pas loin... Essayes avec cette syntaxe: ^C^C_.select;\_.change;_previous;;_property;_color;6;^Z

Bonjour, Pour ma part je suis sous 2011, mais le comportement est le même. Tout ce que je peux te dire, c'est que si tu cherche un calque qui commence par BA, il faut effectivement taper la lettre "B". Un appui successif sur la touche "B" te fera ensuite défiler 1 à 1 tous les calques commençant par "B", effectivement c'est moins rapide que si on pouvait taper 2 lettre de code directement... Vu ce comportement, je ne pense pas qu'il y ait d'option ou de variable en jeu.

Désolé pour la réponse tardive! En fait le lisp était bien conçu pour répondre à ce genre de problème, MAIS j'ai fait une erreur de frappe que j'ai copié-collé plusieurs fois: appel par (nentsel_getreal) au lieu de (nentsel-getreal). Soit tu corrige par toi même, soit tu recharge le code du post #16 que j'ai mis à jour. Avec cette correction, tu devait avoir un code fonctionnel.

Bonjour En faisant ta fonction TEST comme ceci: (defun c:test ( / js js_all n fence js_ins nb) (princ "\nSélectionnez les polylignes: ") (setq js (ssget '((0 . "LWPOLYLINE"))) js_all (ssadd)) (cond (js (repeat (setq n (sslength js)) (setq fence (listpol (ssname js (setq n (1- n)))) js_ins (ssget "_F" fence '((0 . "INSERT"))) ) (cond (js_ins (repeat (setq nb (sslength js_ins)) (ssadd (ssname js_ins (setq nb (1- nb))) js_all) ) ) ) ) (sssetfirst nil js_all) ) ) ) ;;; listpol by Gille Chanteau ; ;;; Returns the vertices list of any type of polyline (WCS coordinates) ; ;;; ; ;;; Argument ; ;;; en, a polyline (ename or vla-object) ; (defun listpol (en / i p l) (setq i (if (vlax-curve-IsClosed en) (vlax-curve-getEndParam en) (+ (vlax-curve-getEndParam en) 1) ) ) (while (setq p (vlax-curve-getPointAtParam en (setq i (1- i)))) (setq l (cons (trans p 0 1 ) l)) ) )

Tout simplement après la ligne (vla-put-TrueColor obj col) inclu dans la boucle (foreach, ceci dans les deux fonction (c:SAT et c:LUM) Autrement si tu est intéressé aussi par la mise en place rapide d'un "patchwork" de MPOLYGON, j'utilise ceci: NB: les sous-fonctions de sont pas de moi (je suis incapable de citer l'auteur, navré pour lui) (defun ACI2RGB (n / l1 l3) (cond ( (or(> n 255)(< n 1))nil) ( (> 7 n 0)(aci2rgb(+ 10(* 40(1- n))))) ( (> 250 n 9) (setq l1 '(0 1 2 3 4 4 4 4 4 4 4 4 4 3 2 1 0 0 0 0 0 0 0 0) ) (setq l3 '(1 0.8 0.6 0.5 0.3)) (mapcar '(lambda(v w / ) (fix (* 255 (+ (* 0.25 (nth(rem(+(1-(/ n 10))v)24)l1) (nth(/(rem n 10)2)l3) ) (* (rem n 2) 0.125 (nth(rem(+(1-(/ n 10))w)24)l1) (nth(/(rem n 10)2)l3) ) ) ) ) ) '(8 0 16) '(20 12 4) ) ) (1 (apply '(lambda(v w / )(list w w w)) (assoc n '((7 255)(8 128)(9 192)(250 51)(251 91)(252 132) (253 173)(254 214)(255 255))) ) ) ) ) (defun randnum (/ modulus multiplier increment random);retourne valeur entre 0 et 1 (if (not seed) (setq seed (getvar "DATE")) ) (setq modulus 65536 multiplier 25173 increment 13849 seed (rem (+ (* multiplier seed) increment) modulus) random (/ seed modulus) ) ) (defun getrandnum (minNum maxNum / tmp);fourchette du nombre aleatoire (if (not (< minNum maxNum)) (progn (setq tmp minNum minNum maxNum maxNum tmp ) ) ) (setq random (+ (* (randnum) (- maxNum minNum)) minNum)) ) (defun c:randnum_color_mpolygon ( / js n obj ncol oColor RGBcolor) (setq js (ssget '((0 . "MPOLYGON")))) (cond (js (repeat (setq n (sslength js)) (setq obj (vlax-ename->vla-object (ssname js (setq n (1- n))))) (while (not (eq (rem (setq ncol (fix (getrandnum 11 241))) 10) 1))) (setq oColor (vlax-get-property obj 'TrueColor) RGBcolor (ACI2RGB ncol) ) (vlax-invoke-method oColor 'SetRGB (car RGBcolor) (cadr RGBcolor) (caddr RGBcolor)) (vla-put-TrueColor obj oColor) (vlax-put-property obj 'PatternFillTrueColor oColor) ) ) ) (prin1) )

Un grand merci (gile), cela fonctionne parfaitement. Je conserve bien mes teintes, au contraire de ce que j'avais pu coder... j'ai juste rajouté: (vlax-put-property obj 'PatternFillTrueColor col) pour pouvoir l'appliquer au remplissage des MPOLYGON de Map. D'ailleurs je ne comprends pas pourquoi je ne peux pas faire un: (vla-put-PatternFillTrueColor obj col)

Merci Tramber, Par curiosité et pour comparaison, j'ai testé aussi le code de Menzi. Si j'ai pu l'appliquer sur quelques échantillons sans problème, sur l'ensemble il a avorté avec un : numberp nil A priori le code est moins fiable que celui de Lee ou (gile), je n'ai pas recherché le bout de code qui pose problème... On ne peut pas être au four et au moulin! ;)

Bonjour, Il te faut déjà regarder la doc sur les formes SHP (un peu ardu, surtout les vecteurs arrondis), puis compiler ce SHP en SHX. Doc autocad sur les formes Puis continuer avec la Doc Autocad sur les types de lignes complexes