(gile)

Salut, Normalement çà ne devrait plus être nécessaire pour les versions antérieures à 2002, mais peut-être faut il que tu fasse (vl-load-com) au tout début ou avant ton programme. Cette fonction charge les fonctions VLISP.

Salut, Personnellement, je fais mes cotations (exepté les cotations des vues en 3D) directement dans l'espace papier de la présentation avec un style de cote "Présentation", sur un calque "Cotations papier", ainsi tous les textes de cotes ont la même hauteur, quelque soit l'échelle de la fenêtre.

Salut, CENTROID n'est pas une variable système dont on peut récupérer la valeur avec (getvar), mais une propriété des objets SOLID et REGION. Pour récupérer la valeur de CENTROID il faut passer par les fonctions VLISP : (vlax-safearray->list (vlax-variant-value (vla-get-centroid (vlax-ename->vla-object (car (entsel)))))) Cette ligne de code retourne les coordonnées du centre de gravité de l'objet sélectionné (à condition que ce soit un solide ou une région). À ce propos, ce sujet et celui là qui contient un LISP qui place un point sur le centre de gravité d'une structure composée de plusieurs régions ou solides de densité différentes. J'ai été "adoubé" Lispeur par Bonuscad le Grand il y a peu, ;) mais je suis fou depuis bien plus longtemps.:mad2: [Edité le 16/11/2005 par (gile)]

Re, Je n'ai pas essayé ton LISP, mais après avoir laissé décanter un peu. Ton problème me semble venir de la liste listobj qui contiendrait des objets qui ne sont pas sur le dessin, et ce, parcequ'elle n'a pas été "vidée". Quand on utilise une liste affectée à une variable, il est prudent de "vider" la variable avant de la redéfinir avec un (setq listobj nil) au cas où cette variable ait déjà été utilisée dans l'exécution d'un LISP dans lequel elle n'était pas déclarée (d'où l'intérêt de déclarer les variables). Mais dans le cas présent, comme le dit Zebulon_, cette liste n'est pas utile, tu peux parcourir directement le jeu de sélection qui, lui, ne peut contenir que les objets existants dans le dessin et qui sont passé par ton filtre de sélection. Bon courage

Salut, Quelques remarques juste comme çà, je n'ai pas approfondi. Tu devrais déclarer tes variables locales, elle seraient renvoyées à nil à la fin de l'exécution de ta routine, sinon, par exemple, à chaque exécution de la routine, dans la variable listobj vont s'ajouter à la liste précédente, les nouveaux blocs sélectionnés. Tu devrais d'ailleurs essayer de diminuer un peu le nombre de variables. Certaines lignes me semblent inutiles, par exemple : - le premier (read-line fic), - comme le dit zebulon_ , le (if (= (cdr tipe) "INSERT") - mais aussi le (if (= (cdr nom) nomblc1) pour la même raison (ce qui répond à la remarque de Florent_Bourg) Question de style, tu pourrais alléger ton code en supprimant des (progn ... par exemple : (progn (setq dx2 (- 0 dx2)) (setq dy2 (- 0 dy2)) ) peu s'écrire : (setq dx2 (- dx2) dy2 (- dy2) ) Enfin peu-être ajouter après le (entmod dxf) un (entupd obj). En espérant t'avoir un peu aidé... À plus

Salut, Question bête : as-tu paramétré dans Outils -> Options... -> Système -> Propriétés... l'accélération matérielle ?

Merci Nazemrap, C'est exactement la réponse que j'attendais. Je m'obstinais à vouloir copier sur une seule ligne la syntaxe des alias existants (comme dans un fichier .MNS ou .MNU), il suffisait de sauter à la ligne... Merci encore. [Edité le 15/11/2005 par (gile)]

Salut, Tout d'abord, il faut copier le code LISP (Choisis cette version elle est corrigée), coller le code dans le bloc-note Windows, et l'enregistrer avec l'extension .lsp (m2s.lsp par exemple). Ensuite dans AutoCAD, tu fais Outils->AutoLISP->Charger une application... et tu choisis le fichier M2s.lsp. Pour lancer la commande tu tapes m2s, tu sélectionnes ta surface, et tu donnes la hauteur que tu veux sous le point le plus bas (au moins l'épaisseur que tu veux pour le solide final). L'extrusion se fait depuis la surface sélectionnée jusqu'au plan parallèle au SCU à la hauteur spécifiée. Tu peux ensuite copier le solide généré, placer la copie sous l'original à l'épaisseur désirée et faire une soustraction. En espérant avoir répondu à tes attentes.

Salut, Pour ce qui est du matériel, je suis plutôt une bille, mais je pense que la configuration nécessaire dépend de l'utilisation que tu fait d'AutoCAD. La 3D nécessite de la RAM (1 Giga selon certains). Il me semble que la vitesse de calcul des rendus dépend plus de la mémoire vive que de la carte graphique. La ressource graphique influe plutôt sur l'affichage (orbite 3D avec textures, ombres...) à condition d'utiliser "l'accélération matérielle". Pour la définition du maillage des surfaces gauches, cela dépend de la valeur des variables système SURFTAB1 (nombre de mailles sur M) et SURFTAB2 (nombre de mailles sur N), à paramétrer avant de lancer la commande. [Edité le 15/11/2005 par (gile)]

Inversement, quand on crée une nouvelle commande, on peut la mettre (ou non) dans une barre d'outils, un menu déroulant, un menu contextuel... par un simple cliquer/déposer. Et çà, au moins, c'est plutôt plus pratique qu'avec les *.mns et *.mnu ;)

Salut, Je n'ai pas réussi à créer un nouveau menu contextuel avec la boite de dialogue "Personnaliser l'interface utilisateur" d'AutoCAD 2006. J'ouvre la boite de dialogue, je fais clic droit sur Menus contextuels -> Nouveau -> Menu contextuel, je renomme "Menu contextuel1", jusque là tout va bien. Mais quand j'essaye de définir l'alias rien ne va plus : je tape "POP519, OBJECT_ARC" dans la boite de dialogue "Alias" et quand je fais OK l'alias est transformé, l'espace entre POP519, et OBJECT_ARC est devenu un underscore et le menu n'est pas reconnu. J'ai essayé sans espace, avec deux espaces, même topo. :casstet: J'ai fini par y arriver dans l'onglet "Transférer" en transférant mon menu contextuel depuis le fichier .MNS d'une personnalisation pour des versions antérieures. Quelqu'un sait-il comment s'y prendre pour créer directement un menu contextuel avec AutoCAD 2006 ? Merci d'avance... [Edité le 14/11/2005 par (gile)]

À propos du premier LISP : Il était donc dommage de se priver de la possibilité de simplement modifier le départ et/ou la fin d'un arc. Il est toujours possible de transformer un arc en cercle ou en ellipse avec l'option "Fermer" et de tranformer un cercle ou une ellipse en arc. Nouvelle version (25/11/05) ;;; ARCEDIT - Convertit un cercle ou une ellipse en arc ou modifie le départ et la fin ;;; d'un arc d'après les angles spécifiés, l'option "Fermer" permet la conversion d'un ;;; arc de cercle en cercle ou d'un arc elliptique en ellipse fermée. (defun c:arcedit (/ val_dxf extr_dir remove-if getang ang->param set1 ent lst ang1 ang2 opt ) ;; Retourne la valeur dxf de l'entité pour le code spécifié (defun val_dxf (code ent) (cdr (assoc code (entget ent))) ) ;; extr_dir Retourne la direction d'extrusion du SCU courant (vecteur) (defun extr_dir () (trans '(0 0 1) 1 0 T) ) ;; Enlève les membres d'une liste répondant à une condition (defun remove-if (fun from) (cond ((atom from) from) ((apply fun (list (car from))) (remove-if fun (cdr from))) (t (cons (car from) (remove-if fun (cdr from)))) ) ) ;; Saisie des angles de départ et de fin de l'arc (option "Fermer") (defun getang () (if (or (= (val_dxf 0 ent) "CIRCLE") (and (= (val_dxf 0 ent) "ELLIPSE") (= (val_dxf 41 ent) 0.0) (= (val_dxf 42 ent) (* 2 pi)) ) ) (progn (setq opt "") (initget 1)) (progn (setq opt " ou [Fermer]") (initget 1 "Fermer")) ) (if (numberp (setq ang1 (getangle (trans (val_dxf 10 ent) ent 1) (strcat "\nSpécifiez l'angle de départ de l'arc" opt ": " ) ) ) ) (progn (initget 1) (setq ang2 (getangle (trans (val_dxf 10 ent) ent 1) "\nSpécifiez l'angle de fin de l'arc: " ) ) (foreach ang '(ang1 ang2) (set ang (+ (eval ang) (angle '(0 0) (trans (getvar "UCSXDIR") 0 (extr_dir))) (getvar "ANGBASE") ) ) ) ) ) ) ;; Convertit l'angle saisi en "paramètre" de l'ellipse (code dxf 41 et 42) (defun ang->param (ang) (setq ang (- ang (angle '(0 0) (trans (val_dxf 11 ent) 0 (extr_dir))) ) ) (atan (sin ang) (* (cos ang) (val_dxf 40 ent))) ) ;; Fonction principale (if (and (= 1 (getvar "pickfirst")) (setq set1 (ssget "_i" '((0 . "ARC,CIRCLE,ELLIPSE")))) (eq 1 (sslength set1)) ) (progn (setq ent (ssname set1 0)) (sssetfirst nil nil) ) (progn (sssetfirst nil nil) (while (not (and (setq ent (car (entsel "\nSélectionnez un arc, un cercle, ou une ellipse: " ) ) ) (or (= (val_dxf 0 ent) "ARC") (= (val_dxf 0 ent) "CIRCLE") (= (val_dxf 0 ent) "ELLIPSE") ) ) ) ) ) ) (setq lst (entget ent)) (if (equal (extr_dir) (val_dxf 210 ent) 1e-009 ) (progn (getang) (cond ((= (val_dxf 0 ent) "ARC") (if (= ang1 "Fermer") (progn (foreach code '(-1 0 330 5 100 50 51) (setq lst (remove-if '(lambda (x) (= (car x) code)) lst) ) ) (setq lst (cons '(0 . "CIRCLE") lst)) ) (setq lst (subst (cons 50 ang1) (assoc 50 lst) lst) lst (subst (cons 51 ang2) (assoc 51 lst) lst) ) ) ) ((= (val_dxf 0 ent) "CIRCLE") (foreach code '(-1 0 330 5 100) (setq lst (remove-if '(lambda (x) (= (car x) code)) lst)) ) (setq lst (append (list '(0 . "ARC") (cons 50 ang1) (cons 51 ang2)) lst ) ) ) ((= (val_dxf 0 ent) "ELLIPSE") (if (= ang1 "Fermer") (setq ang1 0.0 ang2 (* 2 pi) ) (foreach ang '(ang1 ang2) (set ang (ang->param (eval ang))) ) ) (setq lst (subst (cons 41 ang1) (assoc 41 lst) lst) lst (subst (cons 42 ang2) (assoc 42 lst) lst) ) ) ) (command "_regen") (entmake lst) (entdel ent) ) (princ "\nErreur: Le SCU courant et le SCO de l'objet ne sont pas parallèles." ) ) (princ) ) [Edité le 13/11/2005 par (gile)][Edité le 20/11/2005 par (gile)] [Edité le 25/11/2005 par (gile)]

Le même, avec des (command) à la place des (entmake) pour avoir l'affichage dynamique au moment du choix du rayon ou de la seconde extrémité : - Le 27/11/05 - Correction des dysfonctionnements en 3D. ;;; C-E Convertit un cercle en ellipse ou vice-versa (defun c:c-e (/ c-e_err val_dxf set1 ent lst cen os e_lst) ;; Redéfinition de *error* (defun C-E_ERR (msg) (if (or (= msg "Fonction annulée") (= msg "quitter / sortir abandon") ) (princ) (princ (strcat "\nErreur: " msg)) ) (setq *error* m:err m:err nil ) (princ) ) ;; Retourne la valeur dxf de l'entité pour le code spécifié (defun val_dxf (code ent) (cdr (assoc code (entget ent))) ) ;; Fonction principale (setq m:err *error* *error* c-e_err ) (if (and (= 1 (getvar "pickfirst")) (setq set1 (ssget "_i" '((0 . "CIRCLE,ELLIPSE")))) (eq 1 (sslength set1)) ) (progn (setq ent (ssname set1 0)) (sssetfirst nil nil) ) (progn (sssetfirst nil nil) (while (not (and (setq ent (car (entsel "\nSélectionnez un cercle, ou une ellipse: " ) ) ) (or (= (val_dxf 0 ent) "CIRCLE") (= (val_dxf 0 ent) "ELLIPSE") ) ) ) ) ) ) (setq lst (entget ent) cen (trans (val_dxf 10 ent) ent 1) ) (if (equal (trans '(0 0 1) 1 0 T) (val_dxf 210 ent) 1e-009 ) (progn (cond ((= (val_dxf 0 ent) "CIRCLE") (command "_ellipse" "_c" cen pause pause) (if (equal 1.0 (val_dxf 40 (entlast)) 1e-009) (progn (initget "Cercle Ellipse") (if (= (getkword "\nL'ellipse spécifiée est circulaire \nCréer un cercle ou une ellipse [Cercle/Ellipse] ? : " ) "Cercle" ) (progn (setq e_lst (subst (cons 40 (distance '(0 0) (val_dxf 11 (entlast))) ) (assoc 40 lst) lst ) ) (entdel (entlast)) (entmake e_lst) ) ) ) ) ) ((= (val_dxf 0 ent) "ELLIPSE") (command "_circle" cen pause) ) ) (setq e_lst (entget (entlast))) (foreach code '(8 6 62 48) (cond ((and (assoc code lst) (assoc code e_lst)) (setq e_lst (subst (assoc code lst) (assoc code e_lst) e_lst) ) ) ((assoc code lst) (setq e_lst (append e_lst (list (assoc code lst)))) ) ) (entmod e_lst) (entupd (entlast)) ) (initget "Oui Non") (if (/= (getkword "\nEffacer l'objet source ? [Oui/Non] : ") "Non" ) (entdel ent) ) ) (princ "\nErreur: Le SCU courant et le SCO de l'objet ne sont pas parallèles." ) ) (setq *error* m:err m:err nil ) (princ) ) [Edité le 27/11/2005 par (gile)]

Voilà un premier jet de transformation de cercle en ellipse et vice-versa : - Le 11/05/05 à 19h26 - Ajout d'un contrôle au cas où la première extrémité spécifiée pour une ellipse ne serait pas l'extrémité du grand axe et la possibilité de conserver ou d'effacer l'objet source. -Le 12/11/05 à 10h13 - Ajout de la définition de (remove-if) et remplacement des (vl-remove-if) par (remove-if) pour la compatibilité avec les logiciels IntelliCAD, IntelliDESK... - Le 27/11/05 - Correction des dysfonctionnements en 3D. ;;; C-E Convertit un cercle en ellipse ou vice-versa (defun c:c-e (/ val_dxf remove-if set1 ent cen ext dist lst os resp) ;; Retourne la valeur dxf de l'entité pour le code spécifié (defun val_dxf (code ent) (cdr (assoc code (entget ent))) ) ;; Enlève les membres d'une liste répondant à une condition (defun remove-if (fun from) (cond ((atom from) from) ((apply fun (list (car from))) (remove-if fun (cdr from))) (T (cons (car from) (remove-if fun (cdr from)))) ) ) ;; Fonction principale (if (and (= 1 (getvar "pickfirst")) (setq set1 (ssget "_i" '((0 . "CIRCLE,ELLIPSE")))) (eq 1 (sslength set1)) ) (progn (setq ent (ssname set1 0)) (sssetfirst nil nil) ) (progn (sssetfirst nil nil) (while (not (and (setq ent (car (entsel "\nSélectionnez un cercle, ou une ellipse: " ) ) ) (or (= (val_dxf 0 ent) "CIRCLE") (= (val_dxf 0 ent) "ELLIPSE") ) ) ) ) ) ) (setq lst (entget ent) cen (val_dxf 10 ent) ) (if (equal (trans '(0 0 1) 1 0 T) (val_dxf 210 ent) 1e-009 ) (progn (if (zerop (logand 16 (getvar "osmode"))) (progn (setq os (getvar "osmode")) (setvar "osmode" (+ os 16)) ) (setq os nil) ) (cond ((= (val_dxf 0 ent) "CIRCLE") (setq cen (trans cen ent 1) ext (getpoint cen "\nSpécifiez l'extrémité du grand axe: ") dist (getdist cen "\nSpécifiez la distance avec l'autre axe: " ) dist (/ dist (distance cen ext)) ) (if ( (setq ext (polar cen (+ (/ pi 2) (angle cen ext)) (* dist (distance cen ext)) ) dist (/ 1 dist) ) ) (setq cen (trans cen 1 0) ext (mapcar '- (trans ext 1 0) cen) ) (if (equal 1.0 dist 1e-009) (progn (initget "Cercle Ellipse") (setq resp (getkword "\nL'ellipse spécifiée est circulaire \nConserver un cercle ou créer une ellipse [Cercle/Ellipse] ? : " ) ) ) ) (cond ((= resp "Cercle") (setq lst (subst (cons 40 (distance '(0 0) ext)) (assoc 40 lst) lst) ) (command "_regen") (entmake lst) ) (T (foreach code '(-1 0 330 5 10 100 40) (setq lst (remove-if '(lambda (x) (= (car x) code)) lst)) ) (setq lst (append (list '(0 . "ELLIPSE") '(100 . "AcDbEntity") '(100 . "AcDbEllipse") (cons 10 cen) (cons 11 ext) (cons 40 dist) (cons 41 0.0) (cons 42 (* 2 pi)) ) lst ) ) (command "_regen") (entmake lst) ) ) ) ((= (val_dxf 0 ent) "ELLIPSE") (setq dist (getdist (trans cen 0 1) "\nSpécifiez le rayon: ")) (foreach code '(-1 0 330 5 100 10 11 40 41 42) (setq lst (remove-if '(lambda (x) (= (car x) code)) lst)) ) (setq lst (append (list '(0 . "CIRCLE") (cons 10 (trans cen 0 (trans '(0 0 1) 1 0 T))) (cons 40 dist) ) lst ) ) (command "_regen") (entmake lst) ) ) (initget "Oui Non") (if (/= (getkword "\nEffacer l'objet source ? [Oui/Non] : ") "Non" ) (entdel ent) ) (if os (setvar "osmode" os) ) ) (princ "\nErreur: Le SCU courant et le SCO de l'objet ne sont pas parallèles." ) ) (princ) ) [Edité le 11/11/2005 par (gile)][Edité le 12/11/2005 par (gile)] [Edité le 27/11/2005 par (gile)]

Salut, J'y vais aussi de ma réponse, je connaissais aussi, quasi depuis que j'ai découvert AutoCAD, à savoir 2003. Je n'ai pas appris cette fonction durant ma formation, mais dans un livre : "AutoCAD 2002 et applications" de Shumaker - Madsen - Tousignant - Voisard - Noël - Pérusse - Godin, un pavé de 1600 pages et quelques plutôt complèt en ce qui concerne les commandes et leurs options.

Salut, Merci à vous pour les tests et les compliments :red: Comme expliqué ici, le (command "regen") est en fait un moyen que j'ai trouvé pour faire une sorte de marque pour la commande "_undo". Sans ce (command "regen") dans la routine, si on fait "annuler" ou "u" après l'exécution de la routine, çà annule la commande précédent le lancement de la routine (les fonctions entmake, entmod, entupd sont comme "transparentes" pour "_undo"). J'ai donc préféré cette solution à (command "_undo" "_begin") et (command "_undo" "_end"). Je vais essayer de regarder, mais l'idéal serait quelque chose du genre" étirer" le cercle ou l'ellipse et un affichage dynamique avec (grread) et (grvecs), mais là, c'est plus le domaine du "grand" Bonuscad ;) . À plus. [Edité le 10/11/2005 par (gile)]

Je n'ai pas eu beaucoup de temps ces derniers jours, mais voilà la suite du feuilleton commencé dans Transformer un arc en cercle et continué dans Arc->Ellipse ou Arc->Cercle. J'ai regroupé en une seule commande les conversions d'arcs en cercles ou ellipses ou de cercles et d'ellipses en arcs. Suivant l'objet sélectionné la conversion se fait automatiquement ou demande de spécifier les angles de départ et de fin pour les arcs. Les propriétés des objets (calque, couleur, type de ligne...) sont conservées. La principale difficulté que j'ai rencontrée a été la conversion des angles spécifiés en" paramètres" pour les arcs elliptiques (code dxf 41 et 42). -Le 12/11/05 à 10h11 - Ajout de la définition de (remove-if) et remplacement des (vl-remove-if) par (remove-if) pour la compatibilité avec les logiciels IntelliCAD, IntelliDESK... ;;; ACE - Convertit un arc elliptique en ellipse, un arc de cercle en cercle et, ;;; inversement, un cercle ou une ellipse en arc d'après les angles spécifiés. (defun c:ace (/ val_dxf remove-if getang ang->param ent lst ang1 ang2) ;; Retourne la valeur dxf de l'entité pour le code spécifié (defun val_dxf (code ent) (cdr (assoc code (entget ent))) ) ;; Enlève les membres d'une liste répondant à une condition (defun remove-if (fun from) (cond ((atom from) from) ((apply fun (list (car from))) (remove-if fun (cdr from))) (t (cons (car from) (remove-if fun (cdr from)))) ) ) ;; Saisie, par l'utilisateur, des angles de départ et de fin de l'arc (defun getang () (initget 1) (setq ang1 (getangle (trans (val_dxf 10 ent) ent 1) "\nSpécifiez l'angle de départ de l'arc: " ) ) (initget 1) (setq ang2 (getangle (trans (val_dxf 10 ent) ent 1) "\nSpécifiez l'angle de fin de l'arc: " ) ) (foreach ang '(ang1 ang2) (set ang (+ (eval ang) (angle '(0 0) (getvar "UCSXDIR")))) ) ) ;; Convertit l'angle saisi en "paramètre" de l'ellipse (code dxf 41 et 42) (defun ang->param (ang) (setq ang (- ang (angle '(0 0) (trans (val_dxf 11 ent) 0 ent)))) (atan (sin ang) (* (cos ang) (val_dxf 40 ent))) ) ;; Fonction principale (if (and (= 1 (getvar "pickfirst")) (setq set1 (ssget "_i" '((0 . "ARC,CIRCLE,ELLIPSE")))) (eq 1 (sslength set1)) ) (progn (setq ent (ssname set1 0)) (sssetfirst nil nil) ) (progn (sssetfirst nil nil) (while (not (and (setq ent (car (entsel "\nSélectionnez un arc, un cercle, ou une ellipse: " ) ) ) (or (= (val_dxf 0 ent) "ARC") (= (val_dxf 0 ent) "CIRCLE") (= (val_dxf 0 ent) "ELLIPSE") ) ) ) ) ) ) (setq lst (entget ent)) (if (not (equal (mapcar '- (trans '(0 0 1) 1 0) (trans '(0 0 0) 1 0)) (val_dxf 210 ent) 1e-009 ) ) (princ "\nErreur: Le SCU courant et le SCO de l'objet ne sont pas parallèles." ) (cond ((= (val_dxf 0 ent) "ARC") (foreach code '(-1 0 330 5 100 50 51) (setq lst (remove-if '(lambda (x) (= (car x) code)) lst)) ) (setq lst (cons '(0 . "CIRCLE") lst)) (command "_regen") (entmake lst) (entdel ent) ) ((= (val_dxf 0 ent) "CIRCLE") (getang) (foreach code '(-1 0 330 5 100) (setq lst (remove-if '(lambda (x) (= (car x) code)) lst)) ) (setq lst (append (list '(0 . "ARC") (cons 50 ang1) (cons 51 ang2)) lst ) ) (command "_regen") (entmake lst) (entdel ent) ) ((= (val_dxf 0 ent) "ELLIPSE") (cond ((and (= (val_dxf 41 ent) 0.0) (= (val_dxf 42 ent) (* 2 pi)) ) (getang) (foreach ang '(ang1 ang2) (set ang (ang->param (eval ang))) ) (setq lst (subst (cons 41 ang1) (assoc 41 lst) lst) lst (subst (cons 42 ang2) (assoc 42 lst) lst) ) (command "_regen") (entmod lst) (entupd ent) ) (T (setq lst (subst '(41 . 0.0) (assoc 41 lst) lst) lst (subst (cons 42 (* 2 pi)) (assoc 42 lst) lst) ) (command "_regen") (entmod lst) (entupd ent) ) ) ) ) ) (princ) ) Tous les commentaires sont, bien entendu, les bienvenus. [Edité le 12/11/2005 par (gile)]

Salut, Je ne pense pas qu'on puisse modifier les angles des lignes d'attache. Mais j'avais fait un LISP pour coter les longueurs d'arc (pour les versions antérieures à 2006). Ce LISP utilisant la commande "_dimangular" il affiche des lignes d'attache rayonnantes. ;;; DIM_ARC Cotation de la longueur d'un arc ;;; Redéfinition de *error* (defun STD_ERR (msg) (if (or (= msg "Fonction annulée") (= msg "quitter / sortir abandon") ) (princ) (princ (strcat "\nErreur: " msg)) ) (command) (command "_undo" "_end") (RESTORE_VAR) (setq *error* m:err m:err nil ) (princ) ) ;;; SAVE&SET_VAR & RESTORE_VAR ;;; ;;; SAVE&SET_VAR Enregistre la valeur initiale de la variable système dans une liste associative ;;; et lui attribue sa nouvelle valeur ;;; ex: (SAVE&SET_VAR "osmode" 0) -> !varlist (("osmode" . 43)) (getvar "osmode") 0 (defun SAVE&SET_VAR (var value) (if (getvar var) (progn (setq varlist (cons (cons var (getvar var)) varlist)) (setvar var value) ) (princ (strcat "\nErreur: variable AutoCAD rejetée: " var)) ) ) ;;; RESTORE_VAR Restaure leurs valeurs initiales aux variables système de "varlist" (defun RESTORE_VAR () (foreach pair varlist (if (/= (getvar (car pair)) (cdr pair)) (setvar (car pair) (cdr pair)) ) ) (setq varlist nil) ) ;;; ANGARC Retourne l'angle décrit par un arc de cercle. (defun ANGARC (arc / ang) (setq ang (- (cdr (assoc 51 (entget (car arc)))) (cdr (assoc 50 (entget (car arc)))) ) ) (if (minusp ang) (setq ang (+ (* 2 pi) ang)) ) ang ) ;;; Fonction principale (defun c:dim_arc (/ arc arl) (setq m:err *error* *error* STD_ERR ) (command "_undo" "_begin") (princ "Dim_arc") (while (/= (cdr (assoc 0 (entget (car (setq arc (entsel "\nChoisissez un arc: ")))) ) ) "ARC" ) (princ "\nL'objet sélectionné n'est pas un arc.") ) (setq arl (rtos (* (ANGARC arc) (cdr (assoc 40 (entget (car arc))))) (getvar "lunits") (getvar "dimdec") ) ) (SAVE&SET_VAR "cmdecho" 0) (command "_dimangular" arc "_text" arl pause) (command "_undo" "_end") (RESTORE_VAR) (setq *error* m:err m:err nil ) (princ) ) NOTA : Cette cote n'est pas associative : un étirement de l'arc ne génère pas de changement du texte de cote (çà reste du bricolage) [Edité le 9/11/2005 par (gile)]

En une seule commande, transformer les arcs en ellipse ou vice versa, fonctionne aussi avec les cercles (géométriquement parlant, le cercle n'est-il pas une ellipse particulière ?) voir ici. En fait pas encore de "vice-versa" (pas tout à fait au point), mais la possibilité de sélectionner l'arc avant ou après le lancement de la commande.[Edité le 6/11/2005 par (gile)] Çà y est le vice-versa ici [Edité le 10/11/2005 par (gile)]

Cette routine convertit un arc elliptique en ellipse, un arc de cercle en cercle. L'arc peut être sélectionné avant ou après le lancement de la commande. (defun c:a2e (/ val_dxf set1 ent lst) ;;------------------------------------------------ (defun val_dxf (code ent) (cdr (assoc code (entget ent))) ) ;;------------------------------------------------ (if (and (= 1 (getvar "pickfirst")) (setq set1 (ssget "_i" '((0 . "ARC,ELLIPSE")))) (eq 1 (sslength set1)) ) (progn (setq ent (ssname set1 0)) (sssetfirst nil nil) ) (progn (sssetfirst nil nil) (while (not (and (setq ent (car (entsel "\nSélectionnez un arc: ") ) ) (or (= (val_dxf 0 ent) "ARC") (= (val_dxf 0 ent) "ELLIPSE") ) ) ) ) ) ) (setq lst (entget ent)) (cond ((= (val_dxf 0 ent) "ARC") (foreach code '(-1 0 330 5 100 50 51) (setq lst (vl-remove-if '(lambda (x) (= (car x) code)) lst)) ) (setq lst (cons '(0 . "CIRCLE") lst)) (command "_regen") (entmake lst) (entdel ent) ) ((= (val_dxf 0 ent) "ELLIPSE") (cond ((and (= (val_dxf 41 ent) 0.0) (= (val_dxf 42 ent) (* 2 pi)) ) (princ "\n L'ellipse est fermée.") ) (T (setq lst (subst '(41 . 0.0) (assoc 41 lst) lst) lst (subst (cons 42 (* 2 pi)) (assoc 42 lst) lst) ) (command "_regen") (entmod lst) (entupd ent) ) ) ) ) (princ) ) PS : La conversion inverse (ellipse->arc ou cercle->arc) n'est pas encore tout à fait au point. [Edité le 6/11/2005 par (gile)]

La commande inverse, pour transformer un cercle en arc : (defun c:c2a (/ val_dxf cercle cen ang1 ang2) (defun val_dxf (code ent) (cdr (assoc code (entget ent))) ) (while (not (and (setq cercle (car (entsel "\nSélectionnez un cercle: "))) (= (val_dxf 0 cercle) "CIRCLE") ) ) ) (setq cen (val_dxf 10 cercle)) (command "_ucs" "_n" "_ob" cercle) (initget 1) (setq ang1 (getangle '(0 0) "\nSpécifiez l'angle de départ de l'arc: ")) (initget 1) (setq ang2 (getangle '(0 0) "\nSpécifiez l'angle de fin de l'arc: ")) (command "_ucs" "_p") (setq lst (list '(0 . "ARC") (cons 10 cen) (cons 40 (val_dxf 40 cercle)) (cons 8 (val_dxf 8 cercle)) (cons 50 ang1) (cons 51 ang2) (cons 210 (val_dxf 210 cercle)) ) ) (foreach code '(6 62 48) (if (val_dxf code cercle) (setq lst (reverse (cons (cons code (val_dxf code cercle)) (reverse lst)) ) ) ) ) (command "_regen") (entmake lst) (entdel cercle) (princ) ) PS1 : J'ai ajouté un (command "_regen") avant le (entmake) dans les deux codes, pour créer une sorte de marque pour la commande "Annuler". En effet, la création d'objets avec (entmake) est comme "transparente" et la commande "Annuler" (U) lancée après ce type de routine annule le (entmake) et la commande précédente. Peut-être que quelqu'un connaît un moyen plus "élégant" ? PS2 : Pour que la routine fonctionne quelque soit le SCU courant et le SCO du cerle (en 3D), je n'ai trouvé d'autre moyen que de passer par un "SCU objet" temporaire. [Edité le 5/11/2005 par (gile)]

Merci Bonuscad pour tes remarques toujours pertinentes. J'ai effectivement oublié de retirer la gestion de "osmode" quand j'ai remplacé (command) par (entmake), de même, le (trans) qui n'a plus lieu d'être. Pour ce qui est des codes DXF, je n'y ai pas pensé parceque je n'utilise qu'une couleur et qu'un type de ligne par calque, pour le code 8 par contre, j'aurais dû y penser, je corrige : (defun c:a2c (/ val_dxf arc lst) (defun val_dxf (code ent) (cdr (assoc code (entget ent))) ) (while (not (and (setq arc (car (entsel "\nSélectionnez un arc: "))) (= (val_dxf 0 arc) "ARC") ) ) ) (setq lst (list '(0 . "CIRCLE") (cons 10 (val_dxf 10 arc)) (cons 40 (val_dxf 40 arc)) (cons 8 (val_dxf 8 arc)) (cons 210 (val_dxf 210 arc)) ) ) (foreach code '(6 62 48) (if (val_dxf code arc) (setq lst (reverse (cons (cons code (val_dxf code arc)) (reverse lst)) ) ) ) ) (command "_regen") (entmake lst) (entdel arc) (princ) ) [Edité le 5/11/2005 par (gile)]

Salut, Je ne comprends pas bien ta demande, alors je décortique toute la démarche à suivre avec ce LISP : Pour créer le motif, taper DRAWHATCH à la ligne de commande. Le LISP crée l'environnement nécessaire au bon fonctionnement de la suite, à savoir : RESOL activé et paramétré à 0.01X0.01 et un carré de 1X1 dans lequel il faut dessiner le motif de hachures uniquement avec des lignes et des points. Pour enregistrer le motif, taper SAVEHATCH à la ligne de commande, faire "ENTER" comme demandé dans la fenêtre d'AutoCAD, sélectioner le motif (seuls les lignes et points seront sélectionnés), décrire le motif ou faire "ENTER", enregistrer le motif (sous"hachure_perso_1" par exemple) dans un dossier du chemin de recherche d'AutoCAD. Si l'opération est réussie, on lit sur la ligne de commande : "Attendez que le fichier de hachures soit créé SVP..." puis : "Le motif de hachures 'hachure_perso_1' est prêt pour l'utilisation !" Si tu as un dossier spécial pour tes hachures personnalisées dont tu as indiqué le chemin dans les chemins de recherche des fichiers de support (par exemple "C:\Mes_perso\Mes_hachures") tu peux remplacer la ligne surlignée dans le LISP ( "I:\\Acad\\Hatch\\") par ""C:\\Mes_perso\\Mes_hachures\\". J'espère avoir répondu à ta demande.

Salut, Je ne suis pas sûr de comprendre ce que tu veux faire exactement, mais tu devrais trouver une réponse qui te convient parmi les méthodes proposées dans l'aide d'AutoCAD : Guide de personnalisation -> Introduction aux interfaces de programmation -> AutoLISP et Visual LISP -> Chargement et exécution automatiques des routines AutoLISP

Pour ceux qui n'ont pas la chance de travailler avec AutoCAD 2006, mais qui voudraient quand même transformer des arcs en cercles, ce petit LISP : (defun c:a2c (/ arc accrobj_prec) (setq accrobj_prec (getvar "osmode")) (while (not (setq arc (car (entsel "\nSélectionnez un arc: ")))) ) (while (/= (cdr (assoc 0 (entget arc))) "ARC") (setq arc (car (entsel "\L'objet sélectionné n'est pas un arc. \nSélectionnez un arc:" ) ) ) ) (setvar "osmode" 0) (entmake (list '(0 . "CIRCLE") (cons 10 (trans (cdr (assoc 10 (entget arc))) 0 1)) (cons 40 (cdr (assoc 40 (entget arc)))) ) ) (entdel arc) (setvar "osmode" accrobj_prec) (princ) )