bonuscad

Ma version de perpendiculaire, similaire à (gile), utilise vlax-curve-get (defun c:perp2obj (/ js pt en dxf_11) (vl-load-com) (princ "\nSélectionnez un objet curviligne.") (while (setq js (ssget "_+.:E:S" '((0 . "*LINE,ARC,CIRCLE,ELLIPSE") (-4 . "[b]<[/b]NOT") (0 . "MLINE") (-4 . "NOT>")))) (while (setq pt (getpoint "\nDonnez un point pour tracer la perpendiculaire à l'objet: ")) (setq dxf_11 (vlax-curve-getClosestPointTo (setq en (ssname js 0)) (trans pt 1 0))) (cond ((and (not (equal dxf_11 (vlax-curve-getStartPoint en) 1e-9)) (not (equal dxf_11 (vlax-curve-getEndPoint en) 1e-9)) ) (entmake (list (cons 0 "LINE") (cons 10 (trans pt 1 0)) (cons 11 dxf_11) ) ) ) (T (princ "\nPas de perpendiculaire en ce point")) ) ) ) (prin1) )

Le modèle interne (pas de référence dans PAT) dénommé "Utilisateur" "U" ou "_User", devrait répondre à ce besoin. (c'est celui que j'ai utilisé dans ma réponse plus haut) Tu donne l'espacement (0.6) et coche "double hachurage".

Ha bah, alors là, j'en apprends une. ;) J'aurais jamais cru, mais effectivement cela fonctionne. J'ai essayé sur une 2002 avec le motif "Utilisateur". La limitation est l'angle de hachurage, plus il est proche de la perperndulaire aux droites, mieux ca fonctionne. Autrement si c'est un motif simple, on pourrait envisager un type de ligne... A voir, l'avantage et que ton motif suit les courbes (si courbe il y a?)

Dans la 2008, j'ai pas trouvé, pourtant j'ai installé les options d'exemples. Mais j'ai peut être besoin de lunettes, le pire c'est que c'est vrai... :P

Bonjours la communauté. Pour migrer mes fichiers de 2002 vers 2008 j'ai eu besoin de retravailler mes fichiers d'aplats. (hachure solide en couleur attribuée) Voici ce que j'ai réussi à pondre. Le 1er est carrément une copie d'un code trouvé sur un site allemand: Convertir des couleurs ACI en RGB. Le second, j'ai retranscris un algorithme: Eclaircir/Assombrir (valeur négative) toutes les couleurs en jouant sur le facteur lumière (mode TSL) (Voir les liens des sources employées dans les codes respectif) En aurez-vous besoin... ;;http://www.autolisp.mapcar.net/acifarben.html (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 RGB2TrueColor (l_RGB / ) (+ (lsh (car l_RGB) 16) (lsh (cadr l_RGB) 8) (caddr l_RGB)) ) (defun c:256toRGB ( / );js n dxf_ent T_C) (while (null (setq js (ssget "_X" '((-4 . "<") (62 . 256)))))) (setq n -1) (repeat (sslength js) (setq T_C (RGB2TrueColor (ACI2RGB (cdr (assoc 62 (setq dxf_ent (entget (ssname js (setq n (1+ n)))))))))) (entmod (append dxf_ent (list (cons 420 T_C)) ) ) ) (prin1) ) (defun RGB2TrueColor (l_RGB / ) (+ (lsh (car l_RGB) 16) (lsh (cadr l_RGB) 8) (caddr l_RGB)) ) (defun TrueColor2RGB (tc / ) (list (/ tc 65536) (/ (rem tc 65536) 256) (rem tc 65536 256)) ) ;;http://www.easyrgb.com/math.php?MATH=M18#text18 (defun RGB2HSL (l_RGB / l_var min_RGB max_RGB int_RGB ooL Hoo oSo v_RGB) (setq l_var (mapcar '/ l_RGB '(256.0 256.0 256.0)) min_RGB (eval (cons 'min l_var)) max_RGB (eval (cons 'max l_var)) int_RGB (- max_RGB min_RGB) ooL (* (+ max_RGB min_RGB) 0.5) ) (if (equal min_RGB max_RGB) (setq Hoo 0.0 oSo 0.0) (progn (if (< ooL 0.5) (setq oSo (/ int_RGB (+ max_RGB min_RGB))) (setq oSo (/ int_RGB (- max_RGB min_RGB))) ) (setq v_RGB (mapcar '(lambda (x) (/ (+ (/ (- max_RGB x) 6) (* int_RGB 0.5)) int_RGB)) l_var)) (if (= (car l_var) max_RGB) (setq Hoo (- (caddr v_RGB) (cadr v_RGB))) ) (if (= (cadr l_var) max_RGB) (setq Hoo (+ (- (car v_RGB) (caddr v_RGB)) (/ 1.0 3))) ) (if (= (caddr l_var) max_RGB) (setq Hoo (+ (- (cadr v_RGB) (car v_RGB)) (/ 2.0 3))) ) (if (< Hoo 0.0) (setq Hoo (1+ Hoo))) (if (> Hoo 1.0) (setq Hoo (1- Hoo))) ) ) (list (* 3.6 Hoo) oSo ooL) ) (defun Hue2RGB (l / vH) (setq vH (caddr l)) (if (< (caddr l) 0) (setq vH (1+ (caddr l)))) (if (> (caddr l) 1) (setq vH (1- (caddr l)))) (if (< (* 6 vH) 1) (+ (car l) (* 6 vH (- (cadr l) (car l)))) (if (< (* 2 vH) 1) (cadr l) (if (< (* 3 vH) 2) (+ (car l) (* 6 (- (cadr l) (car l)) (- (/ 2.0 3) vH))) (car l) ) ) ) ) (defun HSL2RGB (l_HSL / l_RGB tmp_2 tmp_1 val_R val_G val_B) (if (zerop (cadr l_HSL)) (repeat 3 (setq l_RGB (cons (* (caddr l_HSL) 255) l_RGB))) (progn (if (< (caddr l_HSL) 0.5) (setq tmp_2 (* (caddr l_HSL) (1+ (cadr l_HSL)))) (setq tmp_2 (- (+ (caddr l_HSL) (cadr l_HSL)) (* (caddr l_HSL) (cadr l_HSL)))) ) (setq tmp_1 (- (* (caddr l_HSL) 2.0) tmp_2) val_R (* 255 (Hue2RGB (list tmp_1 tmp_2 (+ (/ (car l_HSL) 3.6) (/ 1.0 3))))) val_G (* 255 (Hue2RGB (list tmp_1 tmp_2 (/ (car l_HSL) 3.6)))) val_B (* 255 (Hue2RGB (list tmp_1 tmp_2 (- (/ (car l_HSL) 3.6) (/ 1.0 3))))) ) (setq l_RGB (mapcar 'atoi (list (rtos val_R 2 0) (rtos val_G 2 0) (rtos val_B 2 0)))) ) ) ) (defun c:Adjust_Light_Color ( / js n dxf_ent l_HSL nw_light) (while (null (setq js (ssget '((-4 . ">") (420 . 0)))))) (setq n -1) (while (> (abs (if (not (setq nw_light (getreal "\nAugmenter+/-Diminuer la luminosité des couleurs aux objets de % <2.5> : "))) (setq nw_light 0.025) (setq nw_light (/ nw_light 100.0)) )) 1 ) (princ "La valeur doit être comprise entre 0% et 100% !") ) (repeat (sslength js) (setq l_HSL (RGB2HSL (TrueColor2RGB (cdr (assoc 420 (setq dxf_ent (entget (ssname js (setq n (1+ n)))))))))) (entmod (subst (cons 420 (RGB2TrueColor (HSL2RGB (list (car l_HSL) (cadr l_HSL) (if (> (+ (caddr l_HSL) nw_light) 1) 1.0 (+ (caddr l_HSL) nw_light)))))) (assoc 420 dxf_ent) dxf_ent ) ) ) (prin1) )

JL, ta remarque me fais penser à ce sujet Autrement ta carte graphique fait-elle partie des cartes testées par AutoDesk sous 2007 ? (sans être forcément certifiée)

Un peu plus d'info. Donc au boulot depuis peu Autocad MAP3D 2008 et Covadis V9.1g Il faut savoir que les administrateurs ont choisi de mettre un profil covadis inaccessible et qui est systématiquement appliqué au lancement d'AutoCAD. Donc dans cette armada d'environnement initialisé les textes annotatifs fonctionnent bien, le hic est pour les blocs, les attributs (2, encadrés d'une polyligne). Cela marche bien quand j'applique mes modifs, tout suit convenablement quand je change d'échelle d'annotation. J'enregistre donc mon dessin, MAIS quand je le réouvre si tout ce qui est texte est de bonne taille, ma polyligne entourant mes attributs se retrouve multiplié par 1000 et les points d'attache de mes attributs on suivis la polyligne malgré leur bonne taillle. Si j'enregistre encore une fois, lors de la réouverture de nouveau un facteur multiplicatif. (aux attributs aussi ce coup ci) :casstet: Je viens d'essayer chez moi sur une Version 2008 classique à trente jours, ET surprise je n'ai pas ce problème, tout suit convenablement d'une session à l'autre. Je soupçonne des paramètres de Covadis, des idées?....

Je n'ai pas suivi de près le fil mais j'ai vu qu'a un moment un lisp (que je n'ai pas essayé) été proposé. Après l'avoir parcouru des yeux, si tu l'a utilisé, je pense que c'est lui qui les a généré. Ma démarche expliquée était manuelle. STB, CTB aucune importance, il sont indépendant du pc3. L'option de suspendre la 1ère impression de PDFCreator, d'imprimer toute les pages qui nous intéresse. Retourner dans le gestionnaire de PDFCreator, sélectionner tout les documents en attente, click-droit et choisir l'option "fusionner" ou le pictogramme adéquat.

lili2006, Chaque fois que tu utilise une imprimante système (pictogramme imprimante), AutoCad crée un PC3 associé (pictogramme traceur) Donc à la première utilisation aucun pc3 (concernant les imprimantes, pas les sortie fichier image ou dwf), tu vas prendre donc ton imprimante virtuelle PDF et la configuré pour un format A4 par exemple. A la validation des modifs Autocad vas créer un pc3 qui va regrouper toutes les options (version de drivers compris) Lorsqu'il propose le nom du pc3 COMPLETE ou CHANGE le nom par défaut, par exemple "PDF en Monochrome format A4" Tu répète l'opération autant de fois que nécessaire pour avoir tes formats les plus courant. Et après tu UTILISE directement tes pc3 sans refaire aucune config. C'est idem pour des traceurs, le seul hic et de s'assurer du bon format de papier chargé, donc en réseau c'est pas le top d'avoir des pc3 avec différent rouleau configuré, a moins d'avoir un multichargeur en option sur le traceur.

Ca y'est enfin, Je me retrouve sur une version MAP3D 2008. (2002 à 2008, quel saut!) Je veux faire évoluer mes bases pour profiter des nouvelles fonctionalités. Si j'ai bien réussi à le faire pour mes textes que j'ai passé en annotatif, j'ai un problème avec un bloc dont je voudrais aussi passer les attributs en annotatif. Bien que le bloc réagisse au échelles d'annotation, le résultat n'est pas au rendez-vous. Quelqu'un a t-il déjà fait évoluer un bloc existant en annotatif? Parce ce que j'ai l'impression que ça fonctionne bien pour la création d'un nouveau bloc, mais pour une redéfinition d'un bloc existant... Un éclairage sur des variables que je ne connaitrai pas, qui foutent le bazar... Déjà passé une 1/2 journée sans succés...

C'est bien moi, un utilisateur ancien d'autocad, qui a horreur des taches répétitives, et qui fait tout pour l'éviter. :P Donc je partage pour simplifier la vie des dessinateurs comme moi. Une solidarité dans le corps du métier en sorte. ;)

Bonjour, Sachant que par trois points en 3D on peut placer une 3Dface. La proposition faite dans ce sujet pourra peut être t'aider. Il ya aussi cette discussion dans le même acabit, toujours avec des 3Dfaces.... Un lisp que j'ai réalisé il y a fort longtemps, et que je n'utilise plus. C'est une interpolation/extrapolation linéaire entre 2 points, la commande place des nouveaux points sur la ligne de coupe choisie. (defun interr (ch / ) (cond ((eq ch "Function cancelled") nil) ((eq ch "quit / exit abort") nil) ((eq ch "console break") nil) (T (princ ch)) ) (command "_.undo" "_end") (command "_.u") (command "_.ucs" "_r" "tmp") (command "_.ucs" "_d" "tmp") (setvar "clayer" plnam) (setvar "aunits" sv_aun) (setvar "angdir" sv_and) (setvar "angbase" sv_anb) (redraw) (setq *error* olderr) (setvar "cmdecho" 1) (princ) ) (defun lpl ( / l l1 x y z) (setq des '()) (setq l (entget (entlast))) (setq l1 (entget (entnext (cdr (assoc -1 l))))) (while (/= "SEQEND" (cdr (assoc 0 l1))) (setq x (cadr (assoc 10 l1))) (setq y (caddr (assoc 10 l1))) (setq z (cadddr (assoc 10 l1))) (setq des (append des (trans (list x y z) 0 1))) (setq l1 (entget (entnext (cdr (assoc -1 l1))))) ) ) (defun ns ( / nus des) (lpl) (prompt "Nombre de sommets disponibles: ") (prin1 (/ (length des) 3)) (initget 7) (while (> (setq nus (getint "\nNumero du sommet a chercher : ")) (/ (length des) 3) ) (prompt "\nSommet inexistant, doit être [b]<[/b] a ") (prin1 (/ (length des) 3)) (initget 7) ) (prompt (strcat "\nSommet " (rtos nus 2 0) "\nX = " (rtos (nth (- (* nus 3) 3) des) 2 3) "\tY = " (rtos (nth (- (* nus 3) 2) des) 2 3) "\tZ = " (rtos (nth (- (* nus 3) 1) des) 2 3) ) ) ) (defun sommet (vx / vx sv en fn som) (setq fn "VERTEX" som () jj () ) (while (= fn "VERTEX") (setq sv (entnext vx) en (entget sv) fn (cdr (assoc 0 en)) som (cons (cdr (assoc 10 en)) som) vx sv ) ) (setq som (reverse (cdr som)) listou (mapcar '(lambda (x) (trans x 0 1)) som) ) ) (defun mdf ( / scle sscle svcle wcle pt sscl cl) (setq svcle "N") (cond ((ssget "X" '((0 . "POLYLINE") (8 . "_PT-TN"))) (command "_.pedit" "_l") (while (/= scle "Sortir") (setq scle "Sortir") (initget "Modifier annUler Sortir") (if (eq (setq scle (getkword "\nSommet [Modifier/annUler/Sortir] [b]<[/b]S>: ")) () ) (setq scle "Sortir") ) (cond ((eq scle "Modifier") (command "_E") (while (/= sscle "Sortir") (initget "N SUIVANt Preced Inser Deplac Regen Lineair ? Sortir Znouveau \r") (prompt "\n[suivaNt/Preced/Inser/Deplac/Znouveau/Regen/Lineair/?/Sortir] [b]<[/b]") (prin1 (read (substr svcle 1 1))) (prompt ">: ") (setq wcle (getkword)) (if (eq wcle ()) (setq sscle svcle) (setq sscle wcle) ) (cond ((or (eq sscle "N") (eq sscle "SUIVANt")) (setq svcle "N") (command "_N") ) ((eq sscle "Preced") (setq svcle "Preced") (command "_P") ) ((eq sscle "Inser") (command "_I") (setq pt (getpoint (getvar"lastpoint") "\nEntrez la position du nouveau sommet :") ) (setq pt (list (car pt) 0.0 (caddr (getvar "lastpoint")))) (command pt) ) ((eq sscle "Deplac") (command "_M") (setq pt (getpoint (getvar"lastpoint") "\nEntrez la nouvelle position :") ) (setq pt (list (car pt) 0.0 (caddr (getvar "lastpoint")))) (command pt) ) ((eq sscle "Znouveau") (command "_M") (setq pt (getpoint (getvar "lastpoint") "\nEntrez la nouvelle position en Z :") ) (setq pt (list (car (getvar "lastpoint")) 0.0 (caddr pt))) (command pt) ) ((eq sscle "Regen") (command "_R") ) ((eq sscle "?") (ns) ) ((eq sscle "Lineair") (command "_S") (setq sscl "N") (while (and (/= sscl "Go") (/= sscl "Sortir")) (initget "N SUIVANt Preced Go Sortir \r") (prompt "\n[suivaNt/Preced/Go/Sortir] [b]<[/b]") (prin1 (read (substr sscl 1 1))) (prompt ">: ") (setq cl (getkword)) (if (eq cl ()) (setq sscl sscl) (setq sscl cl) ) (cond ((or (eq sscl "N") (eq sscl "SUIVANt")) (setq sscl "N") (command "_N") ) ((eq sscl "Preced") (setq sscl "Preced") (command "_P") ) ) ) (cond ((eq sscl "Go") (command "_G") ) ((eq sscl "Sortir") (command "_X") ) ) ) ) ) (command "_X") (setq sscle "N") ) ((or (eq scle "U") (eq scle "ANNUler")) (command "_U") ) ) ) (command "_X") (image (sommet (entlast))) ) ) ) (defun image (soumi / pl o1 o2 l_drw l_draw) (setvar "cvport" (getvar "useri2")) (if (ssget "X" '((0 . "POLYLINE") (8 . "_PT-TN"))) (command "_.erase" "_p" "") ) (setq pl soumi l_draw soumi l_drw nil) (command "_.3dpoly") (repeat (length pl) (command (car pl)) (setq pl (cdr pl)) ) (command "") (command "_.ucs" "_r" "_PT-TN") (command "_.zoom" "_w" (list (apply 'min (mapcar 'car soumi)) (apply 'min (mapcar 'caddr soumi)) ) (list (apply 'max (mapcar 'car soumi)) (apply 'max (mapcar 'caddr soumi)) ) ) (command "_.zoom" "_c" (list (/ (+ (apply 'min (mapcar 'car soumi)) (apply 'max (mapcar 'car soumi)) ) 2 ) (/ (+ (apply 'min (mapcar 'caddr soumi)) (apply 'max (mapcar 'caddr soumi)) ) 2 ) ) "0.8X" ) (setq o1 (trans (list '0.0 (cadr (getvar "vsmin"))) 1 0)) (setq o2 (trans (list '0.0 (cadr (getvar "vsmax"))) 1 0)) (command "_.ucs" "_r" "_GEN") (grdraw (trans o1 0 1) (trans o2 0 1) 1) (while (cadr l_draw) (setq l_drw (append (list 3 (car l_draw) (cadr l_draw)) l_drw)) (setq l_draw (cdr l_draw)) ) (grvecs l_drw) (setvar "cvport" (getvar "useri1")) ) (defun grpl (pt / pt1 pt2 pt3 pt4 rap) (setq rap (getvar "viewsize") pt1 (list (+ (car pt) (/ rap 50)) (+ (cadr pt) (/ rap 50))) pt2 (list (+ (car pt) (/ rap 50)) (- (cadr pt) (/ rap 50))) pt3 (list (- (car pt) (/ rap 50)) (- (cadr pt) (/ rap 50))) pt4 (list (- (car pt) (/ rap 50)) (+ (cadr pt) (/ rap 50))) ) (grdraw pt pt1 -1) (grdraw pt pt2 -1) (grdraw pt pt3 -1) (grdraw pt pt4 -1) ) (defun vrf_pt (p l / nw_seg end_sg l_m ptx ptf cut_po) (setq nw_seg (list p (car l)) end_sg (list p (last l)) l_m l) (while (and (not cut_po) (cdr l)) (setq ptx (inters (car nw_seg) (cadr nw_seg) (car l) (cadr l))) (setq ptf (inters (car end_sg) (cadr end_sg) (car l) (cadr l))) (if (and ptx (not (member T (mapcar '(lambda (x) (equal ptx x 0.000001)) l_m)))) (setq cut_po T) (setq cut_po nil) ) (if (and ptf (not (member T (mapcar '(lambda (x) (equal ptf x 0.000001)) l_m))) (not cut_po)) (setq cut_pt T) ) (setq l (cdr l)) ) (if cut_po T nil ) ) (defun drw_cp (l col / l_drw) (setq l_drw '()) (while (cdr l) (setq l_drw (append (cons (car l) (list (cadr l))) l_drw)) (setq l (cdr l)) ) (grvecs (cons col l_drw)) ) (defun defpo ( / pt pt_lst cut_pt) (setq pt_lst ()) (initget 40 "ANNUler U") (while (or (setq pt (if (car pt_lst) (getpoint (car pt_lst) "\nannUler/[b]<[/b]Extrémité de la ligne>:") (getpoint "\nPremier point du polygone:") ) ) cut_pt ) (cond ((or (eq pt "ANNUler") (eq pt "U")) (drw_cp pt_lst 0) (setq pt_lst (cdr pt_lst)) ) ((= (type pt) 'LIST) (if (> (length pt_lst) 1) (drw_cp pt_lst 0) ) (if (vrf_pt pt pt_lst) (prompt "\nPoint incorrect, les segments de polygone ne peuvent pas se couper.") (setq pt_lst (cons pt pt_lst)) ) ) (T (drw_cp pt_lst 0) (prompt "\nPoint incorrect, les segments de polygone ne peuvent pas se couper.") (setq pt_lst (cdr pt_lst) cut_pt nil) ) ) (if (> (length pt_lst) 1) (drw_cp pt_lst -1) ) (initget 40 "ANNUler U") ) (if ([b]<[/b] (length pt_lst) 3) (progn (if (> (length pt_lst) 1) (progn (prompt "\nPoint incorrect, les segments de polygone ne peuvent pas se couper.") (drw_cp pt_lst 0) ) ) (setq pt_lst nil) ) (drw_cp pt_lst 0) ) pt_lst ) (defun delete (lsb / dl) (setq dl (length lsb) nwlst () ) (repeat (1- dl) (setq nwlst (cons (exfonc min lsb) nwlst) lsb (subst () (car nwlst) lsb) lsb (append (cdr (member () (reverse lsb))) (while (not (null (cdr (member () lsb)))) (setq lsb (cdr (member () lsb))) ) ) lsb (subst (car nwlst) () lsb) ) ) (setq nwlst (cons (car lsb) nwlst)) ) (defun exfonc (fonc l / prov) (setq prov (car l)) (foreach elm (cdr l) (setq prov (eval (list fonc prov elm))) ) ) (defun ordre (cumul / lnb dl cmpt suiv prec pint) (setq lnb (mapcar 'car cumul) dl (length lnb) cmpt 0 ) (delete lnb) (setq dl (length nwlst) listou () ) (repeat dl (setq listou (cons (assoc (car nwlst) cumul) listou) nwlst (cdr nwlst) ) ) (setq nwlst listou) (while nwlst (setq cmpt (1+ cmpt)) (if (eq (car nwlst) ppax) (setq nwlst ()) ) (setq nwlst (cdr nwlst)) ) (setq dl 0 lnb -2 ) (if (= cmpt (length listou)) (setq dl -3 lnb -2) ) (if (= cmpt 1) (setq dl 1 lnb 0) ) (setq suiv (nth (+ cmpt dl) listou) prec (nth (+ cmpt lnb) listou) pint (inters (cons (car suiv) (list (caddr suiv))) (cons (car prec) (list (caddr prec))) '(0.0 0.0) '(0.0 500.0) () ) pint (cons (car pint) (list '0.0 (cadr pint))) listou (subst pint ppax listou) ) ) (defun avec (l / l_bis effect pt test to l_tmp l1 l2 f1 f2 qf q_pt px) (setq l_bis l effect ()) (while l (setq pt (car l)) (setq test (mapcar '(lambda (x) (if (> (angle (list (car pt) (cadr pt)) (list (car x) (cadr x))) pi ) (- (angle (list (car x) (cadr x)) (list (car pt) (cadr pt))) vec_di) (- (angle (list (car pt) (cadr pt)) (list (car x) (cadr x))) vec_di) ) ) l_bis ) ) (setq t0 (mapcar 'minusp test) l_tmp test l1 () l2 () f1 nil f2 nil) (while t0 (if (car t0) (setq l1 (cons (car l_tmp) l1)) (setq l2 (cons (car l_tmp) l2)) ) (setq t0 (cdr t0) l_tmp (cdr l_tmp)) ) (if l1 (setq f1 (apply 'max l1))) (if l2 (setq f2 (apply 'min l2))) (cond ((and f1 f2) (setq qf (min (abs f1) (abs f2))) (if (zerop (rem (abs f1) qf)) (setq qf f1) (setq qf f2)) ) ((and f1 (not f2)) (setq qf f1) ) ((and f2 (not f1)) (setq qf f2) ) ) (setq q_pt (- (length test) (length (member qf test)))) (setq px (nth q_pt l_bis)) (if (null (member (list pt px) effect)) (progn (setq effect (cons (list px pt) effect)) (grdraw pt px 1) (if ptz (grpl ptz)) (interp pt px ppax exg) (grpl ptz) (setq cumul (cons ptz cumul)) ) ) (setq l (cdr l)) ) ) (defun interp (pt1 pt2 ppaxe exg / p1 p2 pint) (setq p1 (cons (car pt1) (cons (cadr pt1) '(0.0))) p2 (cons (car pt2) (cons (cadr pt2) '(0.0))) pint (inters ppaxe exg p1 p2 ()) ptz (inters (cdr pt1) (cdr pt2) '(0.0 0.0) '(0.0 500.00) ()) ptz (cons (car pint) (list '0.0 (cadr ptz))) ) ) (defun param (/ plnw cle cbg chd cbgb first_win second_win po_rec OK) (command "_.undo" "_control" "_all") (command "_.undo" "_auto" "_off") (setvar "maxactvp" 48) (setvar "tilemode" 1) (command "_.view" "_save" "tmp") (command "_.ucs" "") (command "_.plan" "") (prompt "\nNom du plan pour les points interpolés ?[b]<[/b]SEMIS-SUPP>: ") (setq plnw (getstring)) (if (= plnw "") (setvar "users1" "SEMIS-SUPP") (setvar "users1" plnw) ) (prompt "\nLes points interpolés seront exclus de la sélection") (prompt "\nen mode Automatique ou Reprise") (initget "Oui Non") (if (eq (getkword " [Oui/Non][b]<[/b]O>?: ") "Non") (setq exclu nil) (setq exclu T) ) (setvar "tilemode" 0) (command "_.pspace") (if (ssget "X" '((0 . "VIEWPORT"))) (progn (alert (strcat "\tATTENTION !!!." "\nUne mise en page dans l'espace papier existe." "\nSi vous continuez elle sera perdue." "\nTravaillez sur une copie du fichier," "\nou ne sauvegardez pas vos modifications" "\naprès avoir récupéré vos points interpolés" ) ) (initget "Oui Non") (if (eq (getkword "\nVoulez vous continuer [Oui/Non][b]<[/b]N>: ") "Oui") (command "_.erase" "_p" "") (exit) ) ) ) (command "_.zoom" "_ex") (setq cbg (getvar "vsmin") chd (getvar "vsmax") ) (setq cbgb (list (+ (* (/ (- (car chd) (car cbg)) 4.0) 3.0) (car cbg)) (+ (* (/ (- (cadr chd) (cadr cbg)) 4.0) 3.0) (cadr cbg)) ) ) (command "_.mview" "_polygonal" cbg (list (car chd) (cadr cbg)) (list (car chd) (cadr cbgb)) cbgb (list (car cbgb) (cadr chd)) (list (car cbg) (cadr chd)) "_close" ) (setq first_win (entlast)) (setvar "useri1" (cdr (assoc 69 (entget (entlast))))) (command "_.zoom" "_ex") (command "_.mview" cbgb chd) (setq second_win (entlast)) (setvar "useri2" (cdr (assoc 69 (entget (entlast))))) (command "_.mview" "_on" first_win second_win "") (command "_.mspace") (setvar "cvport" (getvar "useri2")) (command "_.layer" "_m" "_PT-TN" "_co" "3" "" "") (command "_.vplayer" "_f" "*" "" "_t" "_PT-TN" "" "") (grdraw '(0.0 0.0) '(0.0 100.0) 1) (setvar "cvport" (getvar "useri1")) (command "_.view" "_restore" "tmp") (command "_.view" "_delete" "tmp") (setvar "users3" "T") ) (defun c:interpol (/ pt ppax exg pt1 pt2 cumul key_md ptz listou codp nom plnam orip absc nwlst cml lmc sv_aun sv_and sv_anb ent js l_wp n vec_di) (setvar "cmdecho" 0) (setq olderr *error* *error* interr) (setq plnam (getvar "clayer") sv_anb (getvar "angbase") sv_and (getvar "angdir") sv_aun (getvar "aunits") ) (setvar "expert" 5) (setvar "limcheck" 0) (setvar "aunits" 0) (setvar "angdir" 0) (setvar "angbase" 0) (command "_.ucs" "_s" "tmp") (if (null (tblsearch "LAYER" "_PT-TN")) (setvar "users3" "nil") ) (if (not (read (getvar "users3"))) (param) ) (command "_.undo" "_group") (command "_.layer" "_thaw" "_PT-TN" "_set" "_PT-TN" "") (if (= (getvar "tilemode") 1) (setvar "tilemode" 0)) (command "_.ucs" "") (setvar "osmode" 32) (initget 17) (setq ppax (getpoint "\nPointez l'axe du profil: int de") ppax (cons (car ppax) (cons (cadr ppax) '(0.0))) ) (setvar "osmode" 1) (initget 17) (setq exg (getpoint "\nPointez l'extrèmité DROITE du profil: ext de") exg (cons (car exg) (cons (cadr exg) '(0.0))) ) (setvar "osmode" 0) (command "_.ucs" "_o" ppax) (setq orip (trans exg 0 1)) (command "_.ucs" "_z" '(0.0 0.0 0.0) orip) (command "_.ucs" "_s" "_GEN") (setvar "cvport" (getvar "useri2")) (command "_.ucs" "_x" "90") (command "_.plan" "") (command "_.ucs" "_s" "_PT-TN") (setvar "cvport" (getvar "useri1")) (command "_.ucs" "_r" "_GEN") (setq cumul ()) (while (/= key_md "OK") (initget "Reprise Automatique MAnuelle MOdification OK") (setq key_md (getkword "\nInterpolation par [Reprise/Automatique/MAnuelle/MOdification/OK] ?[b]<[/b]OK>: ")) (if (not key_md) (setq key_md "OK")) (cond ((eq key_md "Reprise") (setq l_wp (defpo) js (ssadd)) (if exclu (setq js (ssget "_WP" l_wp (list '(0 . "POINT") '(-4 . "*,*,>") '(10 0.0 0.0 0.0) '(-4 . "[b]<[/b]NOT") (cons 8 (getvar "users1")) '(-4 . "NOT>"))) n 0 l_wp ()) (setq js (ssget "_WP" l_wp '((0 . "POINT") (-4 . "*,*,>") (10 0.0 0.0 0.0))) n 0 l_wp ()) ) (cond (js (prompt (strcat "\n" (itoa (sslength js)) " point(s) trouvé(s).")) (repeat (sslength js) (setq ent (ssname js n)) (setq l_wp (cons (cdr (assoc 10 (entget ent))) l_wp)) (setq n (1+ n)) ) (setq l_wp (mapcar '(lambda (x) (trans x 0 1)) l_wp)) (setq l_wp (mapcar '(lambda (x) (list (car x) 0.0 (caddr x))) l_wp)) (setq cumul (if (null cumul) l_wp (append l_wp cumul) ) ) (cond ((>= (length cumul) 2) (setq ppax '(0.0 0.0 0.0)) (ordre (cons ppax cumul)) ) (T ()) ) ) (T (prompt "\nAucun point trouvé") (setq cumul ()) ) ) ) ((eq key_md "Automatique") (initget 33) (setq vec_di (getangle '(0.0 0.0) "\nAngle prioritaire d'interpolation ?: ")) (if (> vec_di pi) (setq vec_di (- vec_di pi))) (setq ppax '(0.0 0.0 0.0) exg (cons (car (trans exg 0 1)) '(0.0 0.0))) (setq l_wp (defpo) js (ssadd)) (if exclu (setq js (ssget "_WP" l_wp (list '(0 . "POINT") '(-4 . "*,*,>") '(10 0.0 0.0 0.0) '(-4 . "[b]<[/b]NOT") (cons 8 (getvar "users1")) '(-4 . "NOT>"))) n 0 l_wp ()) (setq js (ssget "_WP" l_wp '((0 . "POINT") (-4 . "*,*,>") (10 0.0 0.0 0.0))) n 0 l_wp ()) ) (cond (js (prompt (strcat "\n" (itoa (sslength js)) " point(s) trouvé(s).")) (repeat (sslength js) (setq ent (ssname js n)) (setq l_wp (cons (trans (cdr (assoc 10 (entget ent))) 0 1) l_wp)) (setq n (1+ n)) ) (avec l_wp) (cond ((>= (length cumul) 2) (ordre (cons ppax cumul)) ) (T ()) ) ) (T (prompt "\nAucun point trouvé") (setq cumul ()) ) ) ) ((eq key_md "MAnuelle") (setvar "osmode" 8) (initget 17) (while (zerop (caddr (setq pt1 (getpoint "\nDonnez le 1er point: nod de")))) (alert "ATTENTION Z du 1er point nul!") (initget 17) ) (while (/= pt1 ()) (setq pt2 '(0.0 0.0 0.0)) (initget 17) (while (zerop (caddr pt2)) (setq pt2 (getpoint pt1 "\nDonnez le 2ème point: nod de")) (cond ((zerop (caddr pt2)) (alert "ATTENTION Z du 2ème point nul!") (initget 17) ) ((equal (distance (list (car pt1) (cadr pt1)) (list (car pt2) (cadr pt2)) ) 0.0 0.0001 ) (alert "ATTENTION point identique au 1er point") (setq pt2 '(0.0 0.0 0.0)) (initget 17) ) ) ) (grdraw pt1 pt2 1) (setq ppax '(0.0 0.0 0.0) exg (cons (car (trans exg 0 1)) '(0.0 0.0))) (if ptz (grpl ptz)) (interp pt1 pt2 ppax exg) (grpl ptz) (while (member ptz cumul) (setq ptz (cons (+ 0.0001 (car ptz)) (cdr ptz))) ) (setq cumul (cons ptz cumul)) (cond ((>= (length cumul) 2) (ordre (cons ppax cumul)) ) (T ()) ) (prompt "\nPoint interpolé : ")(prin1 (rtos (caddr ptz) 2 2)) (initget 16) (while (zerop (if (eq () (caddr (setq pt1 (getpoint "\nDonnez le 1er point[b]<[/b]RETURN pour fin>: nod de") ) ) ) (quote 1) (caddr pt1) ) ) (alert "ATTENTION Z du 1er point nul!") (initget 16) ) ) (setvar "osmode" 0) ) ((and cumul (eq key_md "MOdification")) (setvar "osmode" 0) (cond (([b]<[/b] (length cumul) 2) (prompt "\nNe peut faire un profil avec un seul point! INCORRECT ") (exit) ) (T (if (not (member '0.0 (mapcar 'car cumul))) (ordre (cons ppax cumul)) ) (if ptz (grpl ptz)) (image listou) (mdf) (if (not (member '0.0 (mapcar 'car listou))) (progn (ordre (cons ppax listou)) (setq cumul listou) ) (progn (ordre listou) (setq cumul listou) ) ) ) ) ) ((and listou (eq key_md "OK")) (prompt "\nPoint interpolé a l'axe : ") (prin1 (rtos (caddr (assoc 0.0 listou)) 2 2)) (initget "Oui Non") (cond ((eq (getkword "\nSauvegarde du profil? [Oui/Non] [b]<[/b]N>: ") "Oui") (repeat (length listou) (entmake (list '(0 . "POINT") (cons 8 (getvar "users1")) (cons 10 (trans (car listou) 1 0)) '(210 0.0 0.0 1.0) '(50 . 0.0) ) ) (setq listou (cdr listou)) ) ) (T (entdel (entlast))) ) (command "_.ucs" "_r" "tmp") (command "_.ucs" "_d" "tmp") ) (T (setq key_md "Interpolation") (prompt "\nProfil non défini. Interpolez ou exécutez une reprise") ) ) (if listou (image listou)) ) (command "_.ucs" "") (command "_erase" (ssget "X" '((0 . "POLYLINE") (8 . "_PT-TN"))) "") (redraw) (setvar "clayer" plnam) (setvar "aunits" sv_aun) (setvar "angdir" sv_and) (setvar "angbase" sv_anb) (command "_.undo" "_end") (setq *error* olderr) (setvar "cmdecho" 1) (prin1) )

Récemment, j'ai du produire un plan avec beaucoup d'aplat. Comme je travaille encore sous une 2002, les couleurs sont limitées à 256. Et même les couleurs les plus clair sont encore trop sombres et soutenues à l'impression. Il faut savoir que je travaille beaucoup avec les XREF. J'ai mes contour et mes hachures dans un fichier distinct. Je trace ce fichier en mode image et retouche la palette (pour l'éclaircir) avec un logiciel d'image et j'attache celui-ci dans mon fichier autocad en détachant mon xref d' hachure. La création de l'image a été un peu laborieuse pour le format. Il faut savoir la résolution que l'on désire 150dpi, 300dpi, 600dpi 300, me semble un bon compromis (résolution utilisé en générale par les Jet d' Encre) et la taille de l'image sera acceptable.(quoique,un peu lourde! A0 dans mon cas en format JPG) 300 DPI étant des Dot Per Inch (Point par pouce), on a donc 300 points pour 2.54cm. A vous de déterminer la taille de votre image avec ses infos de façon que l'attachement se fasse donc à la bonne échelle en gardant la résolution choisie.. On peut donc envisagé la même manip pour protéger ces modèles, tout en pouvant fournir les données essentielles dans le DWG. La manip a du me prendre 1/4h, c'est la 1ere fois que je cherchais à étalonner (en dimension) une image, mais cela à bien fonctionné. J'ai de la couleur sans que cela fasse un patchwork mexicain. :cool:

Tu as la commande des Express "MKSHAPE" qui fait cela. C'est un outil simple mais qui ne sait pas générer des formes arrondies. Donc si cette approximation te suffit (car elle est réglable mais pénalisante) et si un surpoids du fichier SHX ne te gène pas (En effet cet outil crée des SHX avec des octets de coordonnées et jamais avec des octets de vecteurs qui sont beaucoup plus performant et moins gourmand)

J'ai toujours connu AutoCAD avec le Lisp intégré au noyau, même si des modules externes pouvaient venir compléter celui-ci: à une veille époque (DOS) un module pour que le lisp puisse exploiter la mémoire étendue + 1 compilateur et bien sur de nos jour l'incontournable LT-Extender qui débride le noyau lisp dans les versions LT. Je pense que ce dernier pose préjudice et que malgré les tentatives judiciaires d'AutoDesk le problème n'est pas résolu. Supprimer celui-ci serait un moyen pour AutoDesk de mettre un terme à cette faille qu'exploite LT-Extender. A ses début le lisp était le meilleur choix à faire pour de la programmation vers I.A. (Intelligence Artificielle) et orientée objet. Facile à apprendre AutoDesk en à fait sa distinction d'architecture ouverte, ce qui a contribué a faire son succés. Bien que d'autres languages soient maintenant supportés, il sont plus complexes et ne sont pas facilement portables entre versions et/ou machines. Voilà mon analyse sur la question (si elle se pose :P ), que fera AutoDesk ?... PS: Je ne suis jamais tombé sur cette rumeur lors de consultation de forums anglo-saxon.

Mais non, tu ne propose pas du tout la même chose. Toi tu explore un fichier lisp, moi j'explore les fonctions lisp CHARGEES en mémoire. Si le fichier lisp n'est pas chargé, on ne verra rien de spécial .... :casstet: Donc si on charge tous les fichiers qui nous intéresse en mémoire et si on a fait un point de marquage juste avant, on aura la liste des fonctions sans peine. Enfin je pense....

Cette réponse pourrait être utile, je n'ai pas travaillé dessus depuis longtemps mais je pense qu'elle fonctionne encore. A l'époque je me servais aussi du bout de code qui suit pour initialiser ma commande. (Pour info je l'utilisais pour marquer un état par défaut, par exemple à la 1ere installation vierge d'autocad, et je renommais le fichier "atomlst1.ori" obtenu en "atomlst0.ori") Pour des marquages ultérieurs je conserve bien par contre le fichier "atomlst1.ori" produit. Comme ceci j'obtenais les fonctions chargées en mémoire par défaut par autocad, applications tierce et pouvais les exclure ensuite pour faire les tris. NB:Bien sur tous les fichiers (code .lsp et paramètre .ori) dans un dossier de recherche ;) (defun c:fc-init ( / f lst) (cond ((zerop (boole 1 (getvar "dbmod") 1)) (setq f (findfile "atomlst1.ori")) (if f (setq f (open f "w")) (setq f (open "atomlst1.ori" "w")) ) (setq lst (atoms-family 1)) (while lst (if (or (= (car lst) "C:FC-INIT") (= (car lst) "F") (= (car lst) "LST") ) (prompt (strcat "\nSuppression de " (car lst))) (write-line (car lst) f) ) (setq lst (cdr lst)) ) (close f) (prompt "\nCommande FC-LOAD initialisée avec exclusion des fonctions autochargé") (prompt "\nUtilisez à nouveau FC-INIT si des modification sont faites dans ") (prompt "\nles fichiers auto-chargeant des fonction LISP") ) (T (prompt "\nProgramme non effectué.") (prompt "\nIl doit être effectué au début d'un NOUVEAU dessin") ) ) (setq c:fc-init nil f nil lst nil) (prin1) )

tangente alpha = sinus alpha / cosinus alpha cotangente alpha = cosinus alpha / sinus alpha Débloqué ? ;)

Bon, j'entame ce challenge ;) Le code qui suit ne fonctionnera que sur une polyligne 3D. Il vous sera demandé un interval en Z qui devra être répété pour placer les points en Z correspondants (exemple tout les 1 mètres, ou 25 mètre (centimètre,...) (defun round_number (xr n / ) (* (fix (atof (rtos (* xr n) 2 0))) (/ 1.0 n)) ) (defun c:z_interval ( / js dxf_ent vla_obj n pt_lst z_value z_min z_max pt_int) (vl-load-com) (princ "\nSélectionnez une polyligne 3D.") (while (null (setq js (ssget "_+.:E:S" (list '(0 . "POLYLINE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) '(-4 . "[b]<[/b]NOT") '(-4 . "&") '(70 . 112) '(-4 . "NOT>") ) ) ) ) (princ "\nCe n'est pas une polyligne 3D!") ) (setq dxf_ent (entget (ssname js 0)) vla_obj (vlax-ename->vla-object (cdar dxf_ent)) n -1 pt_lst nil ) (if (zerop (getvar "USERR1")) (setvar "USERR1" 1.0)) (initget 6) (setq z_value (getreal (strcat "\nEntrez l'interval en Z [b]<[/b]" (rtos (getvar "USERR1")) ">: "))) (if (not z_value) (setq z_value (abs (getvar "USERR1")))) (setvar "USERR1" z_value) (repeat (fix (vlax-curve-getEndParam vla_obj)) (setq pt_lst (cons (vlax-curve-getPointAtParam vla_obj (setq n (1+ n))) pt_lst)) ) (if (zerop (boole 1 1 (cdr (assoc 70 dxf_ent)))) (setq pt_lst (cons (vlax-curve-getEndPoint vla_obj) pt_lst)) (setq pt_lst (cons (vlax-curve-getStartPoint vla_obj) pt_lst)) ) (while (cdr pt_lst) (setq z_min (round_number (min (caddar pt_lst) (car (cddadr pt_lst))) (/ 1 z_value)) z_max (max (caddar pt_lst) (car (cddadr pt_lst))) ) (while ([b]<[/b] z_min z_max) (setq pt_int (inters (car pt_lst) (cadr pt_lst) (list (caar pt_lst) (cadar pt_lst) z_min) (list (caadr pt_lst) (cadadr pt_lst) z_min) T ) ) (if pt_int (entmake (list (cons 0 "POINT") (cons 100 "AcDbPoint") (cons 10 pt_int) (list 210 0.0 0.0 1.0) ) ) ) (setq z_min (+ z_min z_value)) ) (setq pt_lst (cdr pt_lst)) ) (prin1) ) NB: Le calcul des Z et les points sont traités dans tous les cas dans le SCG. Le code a été testé rapidement.

Bienvenu sur CadXp. Le fichier de définition .LIN sont capricieux, un seul caractère indésirable ou mal placé rend la définition invalide. Le plus courant lors du copier-coller est de vérifier chaque fin de ligne et de s'assurer que le retour chariot est immédiatement présent après le dernier caractère (pas d'espace, de tabulation, de caractère spécial EOF: pas forcément visible dans le bloc-note.) Au pire du retape le contenu en introduisant bien le retour chariot en fin de chaque ligne, il n'est pas bien long (2 lignes) ;) Les définitions ne doivent pas poser de problème suivant la version d'Autocad , soit la définition est bonne et ça fonctionne, soit on un message d'erreurdans ton style

Bonsoir, L'éclaircissement de mon propos: La commande coupure en 1 point ne fonctionne pas sur un cercle (pour Autocad un arc de 360° n'est pas valide). Donc si tu veux pouvoir traiter les cercles pour avoir le point départ et de fin du texte à placer, il faudra un traitement spécial pour celui-ci (ne pas exécuter une coupure en 1 point , mais soit une coupure normale, ou soit une création d'arc basé sur le cercle par exemple) pour pouvoir diviser l'arc . Merci pour tes précisions, je vais regardé les possibilité de ce Soft et surtout s'il est personnalisable à l'aide du lisp. Oui; avec des réacteurs ou alors plus compliqué avec les handles de tous les textes individuel et des xdatas associés à chacun. Briscad n'a peut être pas ces dernières possibilités évoquées. A voir... Bon courage pour l"adaptation.

Salut Matt666, Tout d'abords "BrisCAD" tourne sous Linux? C'est bien ça! J'ai un vieux PC (Celeron), ou j'ai installé un "Ubuntu" pour découvrir le monde Linux. Si j'ai la possibilité d'y faire tourner Briscad et que celui-ci comprends le lisp, cela peut m'intéresser de découvrir ce logiciel. Merci de ton avis à un néophyte de linux ;) Autrement pour répondre à ta question, c'est possible. La méthode simple que j'adopterais pour faire court, mais pas gracieux du tout. faire d'abord un groupe d'annulation créer un bloc d'un nom loufoque constitué simplement d'un point. faire couper la section qui servira de support au texte (NB; pour les cercle ça va coincer !?!) STOCKER le nom de la DERNIERE entité. demander les divers paramètres diviser le segment par le nombre de caractère contenu dans la chaine de texte avec le bloc de nom loufoque en ALIGNANT avec l'objet. remonter jusqu' à la borne par des (entlast) récupérer le point d'insertion et l'angle de rotation du bloc par un (entget) faire un (entdel (entlast)) et continuer la boucle jusqu'à l'entité marquée. executer le groupe d'annulation avec les infos essentielles récoltées mettre en place les caractères un par un voilà en gros la démarche, c'est ce que j'aurais fais des années en arrière sur une version 12 DOS :P

Il n'y a pas de quoi..., je n'en suis aucunement vexé. Il faut dire que Gilles est tellement présent sur le site, que c'est normal qu'on soit habitué à ses propositions. ;) En tout cas MERCI à tous de vos félicitations. Mais le code comporte des bugs si on ne se tient pas dans des scu parrallèles au SCG, mais bon du texte est généralement en 2D...

Ho Grand Décapode "bigleux" ! ;) Moi c'est bonuscad En fait lors de la position 1er point de départ en dynamique, la position du curseur renseigne sur la distance de décalage à appliquer. Ca j'y ai songé, je voulais même faire un groupe anonyme d'office, de même que de faire un groupe d'annulation. Des suggestions peuvent être multiples (point de justification des texte, dessus/dessous, orientation forcée, boite dialogue et j'en passe. J'ai bien dit que j'avais fais au plus simple. :P

Les Express Tools permettent bien d'écrire en rond, mais seulement sur un arc ou un cercle. Il y a bien CURVETEXT sur CadXp, mais se sont des modules ARX et il n'y a pas de modules pour les versions récentes. :( Donc un bout de code (je l'ai fait au plus simple pour limiter la taille) qui permet de faire cela. PS: Le texte est toujours écrit à gauche du sens de parcours de l'objet. (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 draw_pt (pt / pt1 pt2 pt3 pt4) (setq rap (/ (getvar "viewsize") 100) pt1 (list (+ (car pt) rap) (+ (cadr pt) rap) (caddr pt)) pt2 (list (+ (car pt) rap) (- (cadr pt) rap) (caddr pt)) pt3 (list (- (car pt) rap) (- (cadr pt) rap) (caddr pt)) pt4 (list (- (car pt) rap) (+ (cadr pt) rap) (caddr pt)) ) (grdraw pt pt1 -1) (grdraw pt pt2 -1) (grdraw pt pt3 -1) (grdraw pt pt4 -1) ) (defun c:text_curv ( / js dxf_obj PatObj EndDist StartPoint Endpoint tmp tmp0 txt_size str_txt nt part_dist lst_pt next_dist deriv ang dxf_210) (princ "\nSélectionnez un objet curviligne.") (while (null (setq js (ssget "_+.:E:S" (list '(0 . "*LINE,ARC,CIRCLE,ELLIPSE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) '(-4 . "[b]<[/b]AND") '(-4 . "[b]<[/b]NOT") '(0 . "MLINE") '(-4 . "NOT>") '(-4 . "[b]<[/b]NOT") '(-4 . "&") '(70 . 112) '(-4 . "NOT>") '(-4 . "AND>") ) ) ) ) (princ "\nCe n'est pas un objet curviligne valable pour cette fonction!") ) (setq dxf_obj (entget (ssname js 0))) (setq PathObj (vlax-ename->vla-object (ssname js 0))) (setq EndDist (vlax-curve-getDistAtParam PathObj (vlax-curve-getEndParam PathObj)) StartPoint nil EndPoint nil) (draw_pt (trans (vlax-curve-getPointAtDist PathObj 0.0) 0 1)) (princ "\nDonnez l'origine du texte") (while (= 5 (car (setq tmp (grread t 5 1)))) (cond ((= 5 (car tmp)) (if StartPoint (progn (draw_pt (trans StartPoint 0 1)) (grdraw (trans StartPoint 0 1) tmp0 -1))) (setq StartPoint (vlax-curve-getClosestPointTo PathObj (trans (cadr tmp) 1 0)) tmp0 (cadr tmp)) (draw_pt (trans StartPoint 0 1)) (grdraw (trans StartPoint 0 1) (cadr tmp) -1) ) (T (princ "\nArrêt anormal de la commande ")) ) ) (setq StartPoint (vlax-curve-getClosestPointTo PathObj (setq InsPoint (trans (cadr tmp) 1 0)))) (princ "\nDonnez la fin du texte") (while (= 5 (car (setq tmp (grread t 5 1)))) (cond ((= 5 (car tmp)) (if EndPoint (progn (draw_pt (trans EndPoint 0 1)) (grdraw (trans EndPoint 0 1) tmp0 -1))) (setq EndPoint (vlax-curve-getClosestPointTo PathObj (trans (cadr tmp) 1 0)) tmp0 (cadr tmp)) (draw_pt (trans EndPoint 0 1)) (grdraw (trans EndPoint 0 1) (cadr tmp) -1) ) (T (princ "\nArrêt anormal de la commande ")) ) ) (setq EndPoint (vlax-curve-getClosestPointTo PathObj (trans (cadr tmp) 1 0))) (initget 6) (setq txt_size (getdist (trans InsPoint 0 1) (strcat "\nHauteur du texte? [b]<[/b]" (rtos (getvar "TEXTSIZE")) ">: "))) (if (not txt_size) (setq txt_size (getvar "TEXTSIZE"))) (setq str_txt (getstring "\nEntrez le texte: " T) nt 0 lst_pt nil) (setq part_dist (* (/ (- (vlax-curve-getDistAtPoint PathObj EndPoint) (vlax-curve-getDistAtPoint PathObj StartPoint)) (strlen str_txt)) 0.5)) (setq next_dist (+ (vlax-curve-getDistAtPoint PathObj StartPoint) part_dist)) (repeat (strlen str_txt) (setq deriv (vlax-curve-getFirstDeriv PathObj (vlax-curve-getparamatpoint PathObj (setq pt (vlax-curve-getPointAtDist PathObj next_dist))))) (setq ang (atan (cadr deriv) (car deriv))) (if (> (vlax-curve-getDistAtPoint PathObj StartPoint) (vlax-curve-getDistAtPoint PathObj EndPoint)) (setq lst_pt (cons (list (polar pt (- ang (* pi 0.5)) (distance StartPoint InsPoint)) (+ pi ang)) lst_pt)) (setq lst_pt (cons (list (polar pt (+ ang (* pi 0.5)) (distance StartPoint InsPoint)) ang) lst_pt)) ) (setq next_dist (+ next_dist (* 2 part_dist))) ) (foreach n (reverse lst_pt) (setq dxf_210 (z_dir (car n) (polar (car n) (cadr n) (* 0.1 part_dist))) ) (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") (assoc 67 dxf_obj) (assoc 410 dxf_obj) (cons 8 (getvar "CLAYER")) '(100 . "AcDbText") (cons 10 (trans (car n) 0 dxf_210)) (cons 40 txt_size) (cons 1 (substr str_txt (setq nt (1+ nt)) 1)) (cons 50 (cadr n)) '(41 . 1.0) '(51 . 0.0) (cons 7 (getvar "TEXTSTYLE")) '(71 . 0) '(72 . 1) (cons 11 (trans (car n) 0 dxf_210)) (cons 210 dxf_210) '(100 . "AcDbText") '(73 . 0) ) ) ) (vlax-release-object PathObj) (redraw) (prin1) )