(gile)

(gile) s'est penché dessus et a sorti quelque chose. Aussi, j'aurais bien aimé avoir un petit retour, je n'attends pas des remerciements élogieux mais juste savoir si ça répond à la demande, ce qu'il faudrait éventuellement changer ou même si, finalement, Covadis le fait très bien. N'étant ni géomètre ni topographe je ne suis pas sûr d'avoir compris l'utilisation qui peut en être faite. Merci d'avance...

Voilà, les données sont conservées dans le dessin au delà de la session. Il suffisait de remplacer : - les (not *arrow-length*) par (not (vlax-ldata-get "arrow" "length")) - les (rtos *arrow-length*) par (rtos (vlax-ldata-get "arrow" "length")) et les (setq *arrow-length* ...) par (vlax-ldata-put "arrow" "length" ...) de même pour *arrow_ratio* ... (defun c:ARROW (/ arrow_err asn pol leng ratio start ang) (vl-load-com) (defun arrow_err (msg) (if (= msg "Fonction annulée") (princ) (princ (strcat "\nErreur: " msg)) ) (command) (setvar "AUTOSNAP" asn) (setvar "POLARMODE" pol) (setq *error* m:err m:err nil ) (princ) ) (setq asn (getvar "AUTOSNAP") pol (getvar "POLARMODE") m:err *error* *error* arrow_err ) (if (not (vlax-ldata-get "arrow" "length")) (vlax-ldata-put "arrow" "length" (if (= 0 (getvar "DIMASZ")) (if (= 0 (getvar "DIMSCALE")) 1.0 (getvar "DIMSCALE") ) (if (= 0 (getvar "DIMSCALE")) (getvar "DIMASZ") (* (getvar "DIMSCALE") (getvar "DIMASZ")) ) ) ) ) (if (not (vlax-ldata-get "arrow" "ratio")) (vlax-ldata-put "arrow" "ratio" (/ 1.0 3)) ) (prompt (strcat "\nParamètres courants pour la pointe.\tLongueur: " (rtos (vlax-ldata-get "arrow" "length")) "\tRatio: " (rtos (vlax-ldata-get "arrow" "ratio")) ) ) (while (not (vl-consp start)) (initget 1 "Longueur Ratio") (setq start (getpoint "\nPoint de départ de la flèche ou [Longueur/Ratio]: " ) ) (cond ((= start "Longueur") (if (setq leng (getdist (strcat "\nLongueur de la pointe (rtos (vlax-ldata-get "arrow" "length")) ">: " ) ) ) (vlax-ldata-put "arrow" "length" leng) ) ) ((= start "Ratio") (if (setq ratio (getreal (strcat "\nRapport hauteur/largeur de la pointe (rtos (vlax-ldata-get "arrow" "ratio")) ">: " ) ) ) (vlax-ldata-put "arrow" "ratio" ratio) ) ) ) ) (setq leng (vlax-ldata-get "arrow" "length") ratio (vlax-ldata-get "arrow" "ratio") ) (initget 1) (setq ang (getorient start "\nAngle de la flèche")) (command "_.pline" start "_W" 0.0 (* leng ratio) (polar start ang leng) "_W" 0.0 0.0 ) (if (= 0 (getvar "ORTHOMODE")) (progn (setvar "POLARMODE" (+ pol (boole 2 1 pol))) (setvar "AUTOSNAP" (+ asn (boole 2 24 asn))) ) ) (while (not (zerop (getvar "CMDACTIVE"))) (command pause) ) (setvar "AUTOSNAP" asn) (setvar "POLARMODE" pol) (setq *error* m:err m:err nil ) (princ) ) [Edité le 8/11/2006 par (gile)]

C'est une bonne idée, je n'ai pas encore le réflexe. Je vais y réfléchir...

Le problème c'est que (vla-get-activespace AcDoc) retourne 0 quand on est dans l'espace objet d'une fenêtre de l'espace papier. Et je pars du postulat que si une fenêtre est active, c'est pour dessiner dans l'espace objet...

Oui, les valeurs sont sauvegardées dans me dessin pour la session dans des variables globales. Tu pensais peut-être à des Xdata pour ne pas limiter à la session ?

Salut, Pour les valeurs par défaut, pas besoin de changer le code DCL. Dans le LISP, rubrique "Boite d'édition" (plutôt vers la fin), par exemple pour le calque, avant les lignes : (if (= lay "Oui") (set_tile "lay" "1") ) ajoute: (if (not lay) (setq lay "Oui") ) et ainsi de suite pour chaque option que tu veux par défaut. Il suffit de taper U puis ENTER. Dans le LISP toujours, à la fin, après (cond ... remplace : ((= loop 3) (setq ss (ssget '((0 . "INSERT")))) ) par : ((= loop 3) (if (and (= (getvar "PICKFIRST") 1) (setq ss (caddr (ssgetfirst))) ) (sssetfirst nil nil) (setq ss (ssget '((0 . "INSERT")))) ) ) et quand tu cliqueras sur le bouton de Sélection, si une sélection existe, elle sera prise en compte.

Salut, En m'inspirant de ce sujet, un petit LISP qui créé directement un tableau. (defun c:laytable (/ AcDoc Space nlst clst tlst ins table cnt) (vl-load-com) (setq AcDoc (vla-get-activedocument (vlax-get-acad-object)) Space (if (= (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (vlax-for lay (vla-get-Layers AcDoc) (setq nlst (cons (vla-get-Name lay) nlst) clst (cons (vla-get-ColorIndex (vla-get-TrueColor lay)) clst) tlst (cons (vla-get-Linetype lay) tlst) ) ) (setq nlst (cons "Nom" nlst) clst (cons "Couleur" clst) tlst (cons "Type de ligne" tlst) ) (initget 1) (setq ins (trans (getpoint "\nPoint d'insertion: ") 1 0)) (setq table (vla-addTable Space (vlax-3d-point ins) (length nlst) 3 20 100 ) ) (vla-put-TitleSuppressed table :vlax-true) (setq cnt -1) (repeat (vla-get-Rows table) (vla-setText table (setq cnt (1+ cnt)) 0 (nth cnt nlst) ) (vla-setText table cnt 1 (nth cnt clst) ) (vla-setText table cnt 2 (nth cnt tlst) ) (vla-setCellAlignment table cnt 0 5) (vla-setCellAlignment table cnt 1 5) (vla-setCellAlignment table cnt 2 5) ) (princ) ) [Edité le 8/11/2006 par (gile)]

:casstet: Comprends pas... Tu veux utiliser la commade CONTOUR (qui crée une polyligne) ?... Tu veux DECALER une polyligne ?...

Salut et bienvenue, Pour le confort des yeux, j'aurais tendance à conseiller deux écrans de la même taille. Les deux écrans ayant la même résolution, si leur taille est différente, la taille des pixels donc des icones, textes etc... sera différente dans la même proportion. Pour plus de confort encore, je pense que deux écrans de même modèle permettront plus facilement d'afficher les mêmes couleurs.

Salut, Je ne pense pas qu'il y ait de variable système pour revenir au mode des versions précédentes. Je ne suis pas vraiment d'accord, comme tu le dis toi même, la vue en perspective dans les anciennes version ne permettait pas d'y travailler. Maintenant, que les calculs en perspective demandent plus de ressources me paraît évident, il suffit d'avoir fait quelques perspectives coniques de manière rigoureuse "sur la planche" pour l'imaginer. Pour ce qui est de ta configuration, je ne m'y connais pas trop, mais il me semble que si la puissance du processeur influe sur la vitesse des rendus, pour l'affichage, c'est surtout la carte graphique qui bosse et les Matrox n'ont pas très bonne réputation en CAO.

Une petite modification/amélioration. Plutôt que de valider les valeurs par défaut à chaque lancement, entrer "L" ou "R" pour modifier ces valeurs (Longueur et Ratio) avant de spécifier le premier point. (defun c:ARROW (/ arrow_err asn pol leng ratio start ang) (defun arrow_err (msg) (if (= msg "Fonction annulée") (princ) (princ (strcat "\nErreur: " msg)) ) (command) (setvar "AUTOSNAP" asn) (setvar "POLARMODE" pol) (setq *error* m:err m:err nil ) (princ) ) (setq asn (getvar "AUTOSNAP") pol (getvar "POLARMODE") m:err *error* *error* arrow_err ) (if (not *arrow-length*) (setq *arrow-length* (if (= 0 (getvar "DIMASZ")) (if (= 0 (getvar "DIMSCALE")) 1.0 (getvar "DIMSCALE") ) (if (= 0 (getvar "DIMSCALE")) (getvar "DIMASZ") (* (getvar "DIMSCALE") (getvar "DIMASZ")) ) ) ) ) (if (not *arrow-ratio*) (setq *arrow-ratio* (/ 1.0 3)) ) (prompt (strcat "\nParamètres courants pour la pointe.\tLongueur: " (rtos *arrow-length*) "\tRatio: " (rtos *arrow-ratio*) ) ) (while (not (vl-consp start)) (initget 1 "Longueur Ratio") (setq start (getpoint "\nPoint de départ de la flèche ou [Longueur/Ratio]: " ) ) (cond ((= start "Longueur") (if (setq leng (getdist (strcat "\nLongueur de la pointe (rtos *arrow-length*) ">: " ) ) ) (setq *arrow-length* leng) ) ) ((= start "Ratio") (if (setq ratio (getreal (strcat "\nRapport hauteur/largeur de la pointe (rtos *arrow-ratio*) ">: " ) ) ) (setq *arrow-ratio* ratio) ) ) ) ) (setq leng *arrow-length* ratio *arrow-ratio* ) (initget 1) (setq ang (getorient start "\nAngle de la flèche")) (command "_.pline" start "_W" 0.0 (* leng ratio) (polar start ang leng) "_W" 0.0 0.0 ) (if (= 0 (getvar "ORTHOMODE")) (progn (setvar "POLARMODE" (+ pol (boole 2 1 pol))) (setvar "AUTOSNAP" (+ asn (boole 2 24 asn))) ) ) (while (not (zerop (getvar "CMDACTIVE"))) (command pause) ) (setvar "AUTOSNAP" asn) (setvar "POLARMODE" pol) (setq *error* m:err m:err nil ) (princ) )

Déjà une nouvelle version. Accepte un rayon de 0. Possiblité de raccorder des segments non adjacents. Toutefois, il faut que ces segments soient sur des droites concourantes (coplanaires et non parallèles). Les segments doivent appartenir à la même polyligne 3D. Pour joindre des polylignes 3D, on peut utiliser : Join3dPoly

Salut, Tu peux te faire un bouton avec la macro suivant : ^C^Cclayer;0;_close

Je te remercie, mais ne te fais pas de souci, ma vie professionnelle a toujours été une alternance de périodes chômées et de périodes salariées et je m'en accommode.

Suite à ce sujet, je me suis essayé à faire quelque chose d'équivalent aux raccords sur les polylignes 3D. Le code est un peu long (j'entends déjà Didier ...), j'essayerais de faire quelque chose de plus concis, mais je voulais déjà livrer ça à la critique. EDIT : J'avais (encore) oublié de joindre une routine : Norm_3Points Version 1.5 ;;; 3dPolyFillet -Gilles Chanteau- 21/01/07 -Version 1.5- ;;; Crée un "raccord" sur les polylignes 3D (succession de segments) (defun c:3dPolyFillet (/ 3dPolyFillet_err closest_vertices MakeFillet AcDoc ModSp cnt prec rad ent1 ent2 vxlst plst param obj ) (vl-load-com) ;;;*************************************************************;;; (defun 3dPolyFillet_err (msg) (if (= msg "Fonction annulée") (princ) (princ (strcat "\nErreur: " msg)) ) (vla-EndUndoMark AcDoc) (setq *error* m:err m:err nil ) (princ) ) ;;;*************************************************************;;; (defun closest_vertices (obj pt / par) (if (setq par (vlax-curve-getParamAtPoint obj pt)) (list (vlax-curve-getPointAtParam obj (fix par)) (vlax-curve-getPointAtParam obj (1+ (fix par))) ) ) ) ;;;*************************************************************;;; (defun MakeFillet (obj par1 par2 / pts1 pts2 som p1 p2 ptlst norm pt0 pt1 pt2 pt3 pt4 cen ang inc n vlst nb1 nb2 ) (if (and (setq pts1 (closest_vertices obj par1)) (setq pts2 (closest_vertices obj par2)) ) (progn (setq som (inters (car pts1) (cadr pts1) (car pts2) (cadr pts2) nil)) (if som (if (or (equal (car pts1) som 1e-9) (equal (cadr pts1) som 1e-9) (and ( (vlax-curve-getParamAtPoint obj (car pts2)) ) (equal (vec1 (car pts1) (cadr pts1)) (vec1 (car pts1) som) 1e-9 ) ) (and ( (vlax-curve-getParamAtPoint obj (car pts1)) ) (equal (vec1 (cadr pts1) (car pts1)) (vec1 (cadr pts1) som) 1e-9 ) ) ) (progn (if ( (setq p1 (cadr pts1) p2 (car pts2) ) (setq p1 (car pts1) p2 (cadr pts2) ) ) (if (= rad 0) (setq ptlst (list som)) (progn (setq norm (norm_3pts som p2 p1) pt0 (trans som 0 norm) pt1 (trans p1 0 norm) pt2 (trans p2 0 norm) cen (inters (polar pt0 (- (angle pt0 pt1) (/ pi 2)) rad) (polar pt1 (- (angle pt0 pt1) (/ pi 2)) rad) (polar pt0 (+ (angle pt0 pt2) (/ pi 2)) rad) (polar pt2 (+ (angle pt0 pt2) (/ pi 2)) rad) nil ) pt3 (polar cen (- (angle pt1 pt0) (/ pi 2)) rad) pt4 (polar cen (+ (angle pt2 pt0) (/ pi 2)) rad) ang (- (angle cen pt4) (angle cen pt3)) ) (if (and (inters pt0 pt1 cen pt3 T) (inters pt0 pt2 cen pt4 T)) (progn (if (minusp ang) (setq ang (+ (* 2 pi) ang)) ) (setq inc (/ ang prec) n 0 ) (repeat (1+ prec) (setq ptlst (cons (polar cen (- (angle cen pt4) (* inc n)) rad) ptlst ) n (1+ n) ) ) (setq ptlst (mapcar '(lambda (p) (trans p norm 0)) ptlst)) ) ) ) ) (setq vlst (3d-coord->pt-lst (vlax-get obj 'Coordinates))) (if ptlst (progn (setq nb1 (vl-position p1 vlst) nb2 (vl-position p2 vlst) ) (if (= (vla-get-closed obj) :vlax-true) (cond ((and (equal p1 (car vlst)) (equal p2 (cadr (reverse vlst))) ) (setq vlst (append (sublst vlst 1 (1+ nb2)) (reverse ptlst)) ) ) ((and (equal p1 (cadr (reverse vlst))) (equal p2 (car vlst)) ) (setq vlst (append (sublst vlst 1 (1+ nb1)) ptlst)) ) ((and (equal p1 (cadr vlst)) (equal p2 (last vlst)) ) (setq vlst (append (reverse ptlst) (sublst vlst (1+ nb1) nil)) ) ) ((and (equal p1 (last vlst)) (equal p2 (cadr vlst)) ) (setq vlst (append ptlst (sublst vlst (1+ nb2) nil)) ) ) (T (if ( (setq vlst (append (sublst vlst 1 (1+ nb1)) ptlst (sublst vlst (1+ nb2) nil) ) ) (setq vlst (append (sublst vlst 1 (1+ nb2)) (reverse ptlst) (sublst vlst (1+ nb1) nil) ) ) ) ) ) (if (equal (car vlst) (last vlst) 1e-9) (cond ((and (equal p1 (cadr vlst)) (equal p2 (cadr (reverse vlst))) ) (setq vlst (append (sublst vlst 2 nb2) (reverse ptlst) (list (cadr vlst)) ) ) ) ((and (equal p1 (cadr (reverse vlst))) (equal p2 (cadr vlst)) ) (setq vlst (append (sublst vlst 2 nb1) ptlst (list (cadr vlst)) ) ) ) ) (if ( (setq vlst (append (sublst vlst 1 (1+ nb1)) ptlst (sublst vlst (1+ nb2) nil) ) ) (setq vlst (append (sublst vlst 1 (1+ nb2)) (reverse ptlst) (sublst vlst (1+ nb1) nil) ) ) ) ) ) (vlax-put obj 'Coordinates (apply 'append vlst)) ) (prompt "\nLe rayon spécifié est trop grand.") ) ) (prompt "\nLes segments sont divergents.") ) (prompt "\nLes segments ne sont pas concourants.") ) ) (prompt "\nLe rayon spécifié est trop grand.") ) ) ;;;*************************************************************;;; (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) ModSp (vla-get-ModelSpace AcDoc) ) (setq m:err *error* *error* 3dPolyFillet_err ) (vla-StartUndoMark AcDoc) ;; Saisie des données (if (not (vlax-ldata-get "3dFillet" "Prec")) (vlax-ldata-put "3dFillet" "Prec" 20) ) (if (not (vlax-ldata-get "3dFillet" "Rad")) (vlax-ldata-put "3dFillet" "Rad" 10.0) ) (prompt (strcat "\nParamètres courants.\tSegments: " (itoa (vlax-ldata-get "3dFillet" "Prec")) "\tRayon: " (rtos (vlax-ldata-get "3dFillet" "Rad")) ) ) (setq cnt 1) (while (= 1 cnt) (initget 1 "Segments Rayon") (setq ent1 (entsel "\nSélectionnez le premier segment ou [segments/Rayon]: " ) ) (cond ((not ent1) (prompt "\nAucun objet sélectionné.") ) ((= ent1 "Segments") (initget 6) (if (setq prec (getint (strcat "\nSpécifiez le nombre de segments pour les arcs (itoa (vlax-ldata-get "3dFillet" "Prec")) ">: " ) ) ) (vlax-ldata-put "3dFillet" "Prec" prec) ) ) ((= ent1 "Rayon") (initget 4) (if (setq rad (getdist (strcat "\nSpécifiez le rayon (rtos (vlax-ldata-get "3dFillet" "Rad")) ">: " ) ) ) (vlax-ldata-put "3dFillet" "Rad" rad) ) ) ((and (= (cdr (assoc 0 (entget (car ent1)))) "POLYLINE") (= (logand 8 (cdr (assoc 70 (entget (car ent1))))) 8) ) (setq cnt 0) ) (T (prompt "\nL'objet sélectionné n'est pas une polyligne 3D.") ) ) ) (setq prec (vlax-ldata-get "3dFillet" "Prec") rad (vlax-ldata-get "3dFillet" "Rad") ) (while (not ent2) (initget 1 "Tous") (setq ent2 (entsel "\nSélectionnez le deuxième segment ou [Tous]: ")) (if (not (or (= ent2 "Tous") (eq (car ent1) (car ent2)))) (progn (prompt "\nLe segment sélectionné n'est pas sur le même objet" ) (setq ent2 nil) ) ) ) (setq obj (vlax-ename->vla-object (car ent1))) (if (= ent2 "Tous") (progn (setq vxlst (3d-coord->pt-lst (vlax-get obj 'Coordinates)) param 0.5 ) (repeat (if (= (vla-get-closed obj) :vlax-true) (length vxlst) (1- (length vxlst))) (setq plst (append plst (list (vlax-curve-getPointAtParam obj param))) param (1+ param) ) ) (if (or (= (vla-get-closed obj) :vlax-true) (equal (car vxlst) (last vxlst) 1e-9) ) (setq plst (cons (last plst) plst)) ) (setq cnt 0) (repeat (1- (length plst)) (MakeFillet obj (nth cnt plst) (nth (setq cnt (1+ cnt)) plst)) ) ) (MakeFillet obj (trans (osnap (cadr ent1) "_nea") 1 0) (trans (osnap (cadr ent2) "_nea") 1 0) ) ) (vla-EndUndoMark AcDoc) (setq *error* m:err m:err nil ) (princ) ) ;;;*************************************************************;;; ;;;*********************** SOUS ROUTINES ***********************;;; ;;; NORM_3PTS retourne le vecteur normal du plan défini par 3 points (defun norm_3pts (org xdir ydir / norm) (foreach v '(xdir ydir) (set v (mapcar '- (eval v) org)) ) (if (inters org xdir org ydir) (mapcar '(lambda (x) (/ x (distance '(0 0 0) norm))) (setq norm (list (- (* (cadr xdir) (caddr ydir)) (* (caddr xdir) (cadr ydir)) ) (- (* (caddr xdir) (car ydir)) (* (car xdir) (caddr ydir)) ) (- (* (car xdir) (cadr ydir)) (* (cadr xdir) (car ydir)) ) ) ) ) ) ) ;;;*************************************************************;;; ;;; 3d-coord->pt-lst Convertit une liste de coordonnées 3D en liste de points ;;; (3d-coord->pt-lst '(1.0 2.0 3.0 4.0 5.0 6.0)) -> ((1.0 2.0 3.0) (4.0 5.0 6.0)) (defun 3d-coord->pt-lst (lst) (if lst (cons (list (car lst) (cadr lst) (caddr lst)) (3d-coord->pt-lst (cdddr lst)) ) ) ) ;;;*************************************************************;;; ;;; SUBLST Retourne une sous-liste ;;; Premier élément : 1 ;;; (sublst '(1 2 3 4 5 6) 3 2) -> (3 4) ;;; (sublst '(1 2 3 4 5 6) 3 nil) -> (3 4 5 6) (defun sublst (lst start leng / rslt) (if (not ( (setq leng (- (length lst) (1- start))) ) (repeat leng (setq rslt (cons (nth (1- start) lst) rslt) start (1+ start) ) ) (reverse rslt) ) ;;;*************************************************************;;; ;;; VEC1 Retourne le vecteur normé (1 unité) de p1 à p2 (defun vec1 (p1 p2) (if (not (equal p1 p2 1e-009)) (mapcar '(lambda (x1 x2) (/ (- x2 x1) (distance p1 p2)) ) p1 p2 ) ) ) ;;;*************************************************************;;; ;;; BUTLAST Liste sans le dernier élément (defun butlast (lst) (reverse (cdr (reverse lst))) ) [Edité le 7/11/2006 par (gile)][Edité le 8/11/2006 par (gile)][Edité le 8/11/2006 par (gile)][Edité le 9/11/2006 par (gile)][Edité le 14/11/2006 par (gile)][Edité le 10/12/2006 par (gile)][Edité le 11/12/2006 par (gile)] [Edité le 21/1/2007 par (gile)]

Salut et bienvenue, L'accrochage au objets sur les hachures est géré par la variable système OSNAPHATCH : 0 Les accrochages aux objets ignorent les objets de hachures. 1 Les accrochages aux objets traitent les objets de hachures de la même manière que les autres objets. et depuis la version 2007, aussi par la variable système OSOPTIONS : Le paramètre est stocké sous forme de code binaire en utilisant la somme des valeurs suivantes : 0 Les accrochages aux objets fonctionnent sur les objets de hachures et sur la géométrie avec des valeurs Z négatives lors de l'utilisation d'un SCU dynamique. 1 Les accrochages aux objets ignorent les objets de hachures. 2 Les accrochages aux objets ignorent la géométrie avec des valeurs Z négatives lors de l'utilisation d'un SCU dynamique. [Edité le 7/11/2006 par (gile)]

Vous avez bien de la chance que (gile) ait un peu de temps ces jours ci (chômage). Voilà une proposition, je ne sais pas si ça répond à vos attentes mais j'ai essayé de faire polyvalent. Désolé Didier ça dépasse un peu les 10 lignes ;) Edit : j'avais oublié de joindre la routine Norm_3Pts Version 1.2 - ajout de la possibilité d'annuler les derniers points spécifiés 1.1 - reste en option "Ligne" tant que n'est pas spécifée l'option "Arc" et de même en option "Arc" tant que n'est pas spécifée l'option "Ligne" (un peu comme pour les polylignes optimisées). ;;; Gile3dPoly -Gilles Chanteau- 17/11/06 -version 1.2- ;;; Créé une polyligne 3D avec "arcs" ;;; Les arcs sont représentés par une succession de segments jointifs ;;; Le nombre de segments pour les arcs est spécifié par l'utilisateur ;;; Les "arcs" sont définis par "3 points" ou "départ centre fin" et ;;; sont décrits dans le plan défini par ces 3 points. (defun c:Gile3dPoly (/ 3dPolyArc 3dPolyArc_err drawvecs segmentundo AcDoc ModSp prec p1 p2 p3 opt lst cnt new loop1 loop2 ) (vl-load-com) ;;***********************************************************;; (defun 3dPolyArc_err (msg) (if (= msg "Fonction annulée") (princ) (princ (strcat "\nErreur: " msg)) ) (redraw) (vla-EndUndoMark AcDoc) (setq *error* m:err m:err nil ) (princ) ) ;;***********************************************************;; (defun drawvecs (lst) (setq p1 (last lst)) (redraw) (if ( (grvecs (apply 'append (mapcar '(lambda (x1 x2) (list -255 x1 x2) ) (reverse (cdr (reverse lst))) (cdr lst) ) ) ) ) ) ;;***********************************************************;; (defun segmentundo () (if ( (progn (prompt "\nTous les segments ont déjà été annulés.") ) (setq lst (sublst lst 1 (- (length lst) (car cnt))) cnt (cdr cnt) ) ) ) ;;***********************************************************;; (defun 3dPolyArc (p1 p2 p3 opt prec / norm mid1 mid2 cen rad ang inc n ptlst) (if (= opt "3") (setq norm (norm_3pts p2 p3 p1)) (setq norm (norm_3pts p2 p1 p3)) ) (setq p1 (trans p1 0 norm) p2 (trans p2 0 norm) p3 (trans p3 0 norm) ) (if (= opt "3") (setq mid1 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2)) p1 p2) mid2 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2)) p2 p3) cen (inters mid1 (polar mid1 (+ (angle p1 p2) (/ pi 2)) 1.0) mid2 (polar mid2 (+ (angle p2 p3) (/ pi 2)) 1.0) nil ) ) (setq cen p2) ) (setq rad (distance cen p1) ang (- (angle cen p3) (angle cen p1)) ) (if (minusp ang) (setq ang (+ (* 2 pi) ang)) ) (setq inc (/ ang prec) n 0 ) (repeat prec (setq ptlst (cons (polar cen (- (angle cen p3) (* inc n)) rad) ptlst) n (1+ n) ) ) (setq ptlst (mapcar '(lambda (p) (trans p norm 0)) ptlst)) ) ;;***********************************************************;; (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) ModSp (vla-get-ModelSpace AcDoc) ) (setq m:err *error* *error* 3dPolyArc_err ) (vla-StartUndoMark AcDoc) (if (not (vlax-ldata-get "3dPolyArc" "prec")) (vlax-ldata-put "3dPolyArc" "prec" 20) ) (prompt (strcat "\nParamètre courant - Nombre de segments par arc: " (itoa (vlax-ldata-get "3dPolyArc" "prec")) ) ) (while (not (vl-consp p1)) (initget 1 "Segments") (setq p1 (getpoint "\nSpécifiez le point de départ de la polyligne ou [segments]: " ) ) (if (= p1 "Segments") (progn (initget 6) (if (setq prec (getint (strcat "\nSpécifiez le nombre de segments pour les arcs (itoa (vlax-ldata-get "3dPolyArc" "prec")) ">: " ) ) ) (vlax-ldata-put "3dPolyArc" "prec" prec) ) ) ) ) (setq prec (vlax-ldata-get "3dPolyArc" "prec") lst (cons p1 lst) cnt (cons 1 cnt) loop1 T ) (while loop1 (initget "Arc annUler") (setq p1 (last lst) p2 (getpoint p1 "\nSpécifiez l'extrémité de la ligne ou [Arc/annUler]: " ) ) (if p2 (progn (if (= p2 "annUler") (segmentundo) (if (= p2 "Arc") (progn (setq loop2 T) (while loop2 (setq p2 p1) (while (equal p1 p2 1e-9) (initget "Centre Ligne annUler") (setq p2 (getpoint p1 "\nSpécifiez le deuxième point de l'arc ou [Centre/Ligne/annUler]: " ) ) ) (if p2 (if (= p2 "Ligne") (setq loop2 nil) (if (= p2 "annUler") (progn (segmentundo) (drawvecs lst) ) (progn (if (= p2 "Centre") (progn (setq p2 p1) (while (equal p2 p1) (initget 1) (setq p2 (getpoint p1 "\tSpécifiez le centre de l'arc: " ) ) ) (setq opt "c") ) (setq opt "3") ) (setq p3 p2) (while (equal p2 p3) (initget 1 "annUler") (setq p3 (getpoint p2 "\nSpécifiez l'extrémité de l'arc: ") ) ) (setq new (3dPolyArc (last lst) p2 p3 opt prec) lst (append lst new) cnt (cons (length new) cnt) ) (drawvecs lst) ) ) ) (setq loop2 nil loop1 nil ) ) ) ) (setq lst (append lst (list p2)) cnt (cons 1 cnt) ) ) ) (drawvecs lst) ) (setq loop1 nil) ) ) (if ( (vlax-invoke ModSp 'add3dPoly (apply 'append (mapcar '(lambda (p) (trans p 1 0)) lst)) ) ) (redraw) (vla-EndUndoMark AcDoc) (setq *error* m:err m:err nil ) (princ) ) ;;***********************************************************;; ;;; NORM_3PTS retourne le vecteur normal du plan défini par 3 points (defun norm_3pts (org xdir ydir / norm) (foreach v '(xdir ydir) (set v (mapcar '- (eval v) org)) ) (if (inters org xdir org ydir) (mapcar '(lambda (x) (/ x (distance '(0 0 0) norm))) (setq norm (list (- (* (cadr xdir) (caddr ydir)) (* (caddr xdir) (cadr ydir)) ) (- (* (caddr xdir) (car ydir)) (* (car xdir) (caddr ydir)) ) (- (* (car xdir) (cadr ydir)) (* (cadr xdir) (car ydir)) ) ) ) ) ) ) ;;; SUBLST Retourne une sous-liste ;;; Premier élément : 1 ;;; (sublst '(1 2 3 4 5 6) 3 2) -> (3 4) ;;; (sublst '(1 2 3 4 5 6) 3 nil) -> (3 4 5 6) (defun sublst (lst start leng / rslt) (if (not ( (setq leng (- (length lst) (1- start))) ) (repeat leng (setq rslt (cons (nth (1- start) lst) rslt) start (1+ start) ) ) (reverse rslt) ) [Edité le 7/11/2006 par (gile)][Edité le 16/11/2006 par (gile)] [Edité le 17/11/2006 par (gile)]

Re, Je pense que ça vient des deux lignes : (vla-put-Layer reg lay) (vla-put-Color reg col) à la fin du LISP. Le LISP répondait à un besoin spécifique et certaines modifications ont été apportées par Bred, je lui disais à ce sujet : Puisque ce LISP semble en intéresser d'autres, je remet ci-dessous une version plus polyvalente. ;;; 2d-coord->pt-lst Convertit une liste de coordonnées 2D (Coordinates) ;;; en liste de points 3D (SCG). ;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0 0.0) (3.0 4.0 0.0)) (defun 2d-coord->pt-lst (lst elv norm) (if lst (cons (trans (list (car lst) (cadr lst) elv) norm 0) (2d-coord->pt-lst (cddr lst) elv norm) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:pl2r (/ AcDoc Space ss wid lst reg pt1 pt2) (vl-load-com) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . ">") (43 . 0)))) (progn (vla-StartUndoMark AcDoc) (foreach pl (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (setq pl (vlax-ename->vla-object pl) wid (vla-get-ConstantWidth pl) lst (append (vlax-invoke pl 'Offset (/ wid 2)) (vlax-invoke pl 'Offset (/ wid -2)) ) ) (if (= (vla-get-Closed pl) :vlax-true) (progn (setq reg (vlax-invoke Space 'addRegion lst)) (if ( (setq reg (reverse reg)) ) (vla-Boolean (car reg) acSubtraction (cadr reg)) ) (progn (mapcar '(lambda (sym obj) (set sym (2d-coord->pt-lst (vlax-get obj 'Coordinates) (vlax-get obj 'Elevation) (vlax-get obj 'Normal) ) ) ) '(pt1 pt2) lst ) (setq lst (append (list (vla-addLine Space (vlax-3d-point (car pt1)) (vlax-3d-point (car pt2)) ) ) (list (vla-addLine Space (vlax-3d-point (last pt1)) (vlax-3d-point (last pt2)) ) ) lst ) ) (vlax-invoke Space 'addRegion lst) ) ) (mapcar 'vla-delete lst) (vla-delete pl) ) (vla-EndUndoMark AcDoc) ) ) (princ) )

Salut Boris, Toutes mes excuses, dans la discussion avec Bred pour améliorer la routine principale j'ai oublié de recopier la sous routine 2d-coord->pt-lst qui transforme la liste retourne par (vlax-get obj 'Coordinates) en liste de oints 3D dans le SCG. Je répare cet oubli.

Peut-être, mais la demande est de transformer des polylignes de largeur constante en régions, et la dernière routine semble répondre à la demande, alors ...

Bien vu, (mapcar 'vla-delete lst) était mal placé. Ton (vlax-put-property (vlax-ename->vla-object (entlast)) 'Layer lay) est propre et efficace. On peut néanmoins gagner quelques lignes : ;;; 2d-coord->pt-lst Convertit une liste de coordonnées 2D (Coordinates) ;;; en liste de points 3D (SCG). ;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0 0.0) (3.0 4.0 0.0)) (defun 2d-coord->pt-lst (lst elv norm) (if lst (cons (trans (list (car lst) (cadr lst) elv) norm 0) (2d-coord->pt-lst (cddr lst) elv norm) ) ) ) (defun c:pl2r (/ AcDoc Space ss wid lst reg pt1 pt2) (vl-load-com) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . ">") (43 . 0)))) (progn (vla-StartUndoMark AcDoc) (foreach pl (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (setq pl (vlax-ename->vla-object pl) wid (vla-get-ConstantWidth pl) lst (append (vlax-invoke pl 'Offset (/ wid 2)) (vlax-invoke pl 'Offset (/ wid -2)) ) ) (if (= (vla-get-Closed pl) :vlax-true) (progn [b](setq reg (vlax-invoke Space 'addRegion lst)) (if ( (setq reg (reverse reg)) ) (vla-Boolean (car reg) acSubtraction (cadr reg)) (setq reg (car reg))[/b] ) (progn (mapcar '(lambda (sym obj) (set sym (2d-coord->pt-lst (vlax-get obj 'Coordinates) (vlax-get obj 'Elevation) (vlax-get obj 'Normal) ) ) ) '(pt1 pt2) lst ) (setq lst (append (list (vla-addLine Space (vlax-3d-point (car pt1)) (vlax-3d-point (car pt2)) ) ) (list (vla-addLine Space (vlax-3d-point (last pt1)) (vlax-3d-point (last pt2)) ) ) lst ) ) [b](setq reg (car (vlax-invoke Space 'addRegion lst)))[/b] ) ) [b](vla-put-Layer reg lay) (vla-put-Color reg col)[/b] (mapcar 'vla-delete lst) (vla-delete pl) ) (vla-EndUndoMark AcDoc) ) ) (princ) ) PS : Les variables lay et col ne sont pas définies dans le LISP. Avec les versions antérieures, les régions sont créées sur le calque courant dans la couleur courante ... [Edité le 5/11/2006 par (gile)] [Edité le 5/11/2006 par (gile)]

Salut x_all, Les fichiers DCL sont les fichiers de description des boites de dialogue. Le LISP appelle un fichier DCL pour ouvrir une boite de dialogue. Le fichier DCL doit donc être enregistré sous le nom par lequel il est appelé dans le LISP et dans un dossier du chemin de recherche des fichiers de support. Soit un dossier existant comme le suggère le crabe, soit un dossier personnel dont on indique le chemin dans les chemins de recherche. Pour Edit_Bloc, si tu télécharges le ZIP, tu y trouveras un fichier .VLX, il s'agit d'un fichier compilés (contenant les LISP et DCL nécessaire au programme). Tu peux ne charger que ce fichier et le programme fonctionnera.

Edit_bloc est dans la zone Téléchargements proposés par les membres rubrique "LISP et VisualLISP". Ou plus directement : Télécharger Edit_Bloc

J'ai un peu remanié le LISP, juste une question de style, le fonctionnement est identique.

Re, Voici une version en VisualLISP qui devrait fonctionner dans tous les cas (vla-offset décale d'un côté ou de l'autre suivant le signe de la distance de décalage). ;;; 2d-coord->pt-lst Convertit une liste de coordonnées 2D (Coordinates) ;;; en liste de points 3D (SCG). ;;; (2d-coord->pt-lst '(1.0 2.0 3.0 4.0)) -> ((1.0 2.0 0.0) (3.0 4.0 0.0)) (defun 2d-coord->pt-lst (lst elv norm) (if lst (cons (trans (list (car lst) (cadr lst) elv) norm 0) (2d-coord->pt-lst (cddr lst) elv norm) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:pl2r (/ AcDoc Space ss wid lst reg pt1 pt2) (vl-load-com) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . ">") (43 . 0)))) (progn (vla-StartUndoMark AcDoc) (foreach pl (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (setq pl (vlax-ename->vla-object pl) wid (vla-get-ConstantWidth pl) lst (append (vlax-invoke pl 'Offset (/ wid 2)) (vlax-invoke pl 'Offset (/ wid -2)) ) ) (mapcar '(lambda (x) (vla-put-ConstantWidth x 0.0)) lst) (if (= (vla-get-Closed pl) :vlax-true) (progn (setq reg (vlax-invoke Space 'addRegion lst)) (if ( (vla-Boolean (cadr reg) acSubtraction (car reg)) (vla-Boolean (car reg) acSubtraction (cadr reg)) ) ) (progn (mapcar '(lambda (sym obj) (set sym (2d-coord->pt-lst (vlax-get obj 'Coordinates) (vlax-get obj 'Elevation) (vlax-get obj 'Normal) ) ) ) '(pt1 pt2) lst ) (setq lst (append (list (vla-addLine Space (vlax-3d-point (car pt1)) (vlax-3d-point (car pt2)) ) ) (list (vla-addLine Space (vlax-3d-point (last pt1)) (vlax-3d-point (last pt2)) ) ) lst ) ) (vlax-invoke Space 'addRegion lst) ) ) (vla-delete pl) ) (mapcar 'vla-delete lst) (vla-EndUndoMark AcDoc) ) ) (princ) ) [Edité le 4/11/2006 par (gile)]