bonuscad

Tu n'a pas de routine à créer ?!?! . Tu fais simplement un copier-coller dans le bloc-note que tu enregistreras dans un fichier. Dans ce cas ici présent choirsir comme nom "Ordrecalque.lsp " pour la première partie et "Odrecalque.dcl" pour la deuxième. Ces fichiers DOIVENT (ici à cause du DCL qui est necessaire à la routine) être enregistrés dans un chemin de recherche d'AutoCAD. (ceux déclaré dans les options) Tape la commande "APPLOAD" et sélectionne ton fichier .lsp

Bonjour Pour que la polyligne ne soit pas pleine, il y a bien la variable "FILLMODE" à 0, mais cela ne concerne que l'aspect à l'affichage, cela ne transforme pas ta polyligne en rectangle. Est ce suffisant?

Salut, Une ébauche de routine qui peut comporter des imperfections, mais qui réalise ton souhait (enfin devrait) Le lisp: OrdreCalque.lsp (defun ordclqerr (ch) (cond ((eq ch "Function cancelled") nil) ((eq ch "quit / exit abort") nil) ((eq ch "console break") nil) (T (princ ch)) ) (command "_.undo" "_end") (if (<= sv_und 3) (command "_.undo" "_control" "_one")) (command "_.undo" "1") (setq *error* olderr) (setvar "cmdecho" 1) (princ) ) (defun lst2listbox ( lststr lstbox / ) (start_list lstbox) (mapcar 'add_list lststr) (end_list) ) (defun lay_add ( lstlay lstlf / lstnum) (setq lstnum (read (strcat "(" (get_tile "lst_all_lay") ")"))) (foreach num lstnum (if (not (member (nth num lstlay) lstlf)) (setq lstlf (cons (nth num lstlay) lstlf)) ) ) (lst2listbox lstlf "lst_sel_lay") lstlf ) (defun lay_sub ( lstlf / lstnum lstote) (setq lstnum (read (strcat "(" (get_tile "lst_sel_lay") ")"))) (setq lstote (mapcar '(lambda (num) (nth num lstlf)) lstnum)) (foreach layername lstote (setq lstlf (append (reverse (cdr (member layername (reverse lstlf)))) (cdr (member layername lstlf)) ) ) ) (lst2listbox lstlf "lst_sel_lay") lstlf ) (defun makelaylists (/ layname ss cvpname xdlist vpldata sortlist name templist) (if (= (setq tilemode (getvar "tilemode")) 0) (progn (setq ss (ssget "_x" (list (cons 0 "VIEWPORT") (cons 69 (getvar "CVPORT")) ) ) ) (setq cvpname (ssname ss 0)) (setq xdlist (assoc -3 (entget cvpname '("acad")))) (setq vpldata (cdadr xdlist)) ) ) (setq sortlist nil) (setq templist (tblnext "LAYER" T)) (while templist (setq name (cdr (assoc 2 templist))) (setq sortlist (cons name sortlist)) (setq templist (tblnext "LAYER")) ) (if (>= (getvar "maxsort") (length sortlist)) (setq sortlist (acad_strlsort sortlist)) (setq sortlist (reverse sortlist)) ) ) (defun c:ordrecalque ( / sv_und olderr dcl_id lstlay lstlf t_xwt ok_cmd lst_order dxf_67 jss) (setvar "CMDECHO" 0) (if (<= (setq sv_und (getvar "undoctl")) 3) (command "_.undo" "_control" "_all") ) (command "_.undo" "_group") (setq olderr *error* *error* ordclqerr) (setq dcl_id (load_dialog "ordrecalque.dcl")) (if (new_dialog "ordrecalque" dcl_id) (progn (setq lstlay (makelaylists) lstlf '()) (lst2listbox lstlay "lst_all_lay") (lst2listbox lstlf "lst_sel_lay") (action_tile "pick_add" "(setq lstlf (lay_add lstlay lstlf))") (action_tile "pick_sub" "(setq lstlf (lay_sub lstlf))") (action_tile "xwt_frt" "(setq t_xwt $value)") (action_tile "accept" "(done_dialog 1)") (setq ok_cmd (start_dialog)) (if (= ok_cmd 1) (progn (setq lst_order (reverse lstlf)) (if (eq (getvar "CVPORT") 1) (setq dxf_67 '(67 . 1)) (setq dxf_67 '(67 . 0)) ) ; (setq dxf_69 (cons 69 (getvar "CVPORT"))) (while lst_order (setq js (ssget "_X" (list dxf_67 (cons 8 (car lst_order))))) (if (not (null js)) (command "_.draworder" js "" "_front") ) (setq lst_order (cdr lst_order)) ) ) ) (cond (t_xwt (setq js (ssget "_X" (list dxf_67 '(0 . "WIPEOUT")))) (if (not (null js)) (command "_.draworder" js "" "_front") ) (setq js (ssget "_X" (list dxf_67 '(0 . "TEXT")))) (if (not (null js)) (command "_.draworder" js "" "_front") ) (setq js (ssget "_X" (list dxf_67 '(0 . "MTEXT")))) (if (not (null js)) (command "_.draworder" js "" "_front") ) ) ) ) ) (command "_.undo" "_end") (if (<= sv_und 3) (command "_.undo" "_control" "_one")) (command "_.undo" "1") (setq *error* olderr) (setvar "CMDECHO" 1) (princ) ) et le DCL: OrdreCalque.dcl ordrecalque : dialog { label= "Sélection des calques à ordonner pour l'affichage"; : column { : row { : list_box { label = "Liste des Calques"; key = "lst_all_lay"; width = 25; multiple_select = true; } : column { fixed_height = true; : button {key = "pick_add"; label = ">";} : button {key = "pick_sub"; label = "<";} } : list_box { label = "Calques ordonnés à sousmettre"; key = "lst_sel_lay"; width = 25; multiple_select = true; } : column { :text { label = "Priorité +"; } :text { label = "Priorité -"; } } } : toggle { label = "Placer les Textes et Masques au dessus de tout en dernier"; mnemonic = "T"; key = "xwt_frt"; } ok_cancel; } }

Je vous propose 3 routines pour créer des figure 2D simple (avec polyligne) . Si ces figures sont simples le programme l'a été un peut moins. J'ai voulu sophistiquer le mode dynamique avec la fonction (grread) qui n'accepte pas le mode des ACCROBJ la fonction (gr-osmode) ma permis de re-simuler ces mode d'accrochage. Tout commentaire sur ce code est le bienvenu. 1er (reprise de rectangle par centre) (defun gr-osmode (pt-i str-md / n pt md rap pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt56 pt67 pt78 pt85 one_o) (setq n (/ (cadr (getvar "screensize")) 5.0)) (setq pt (osnap pt-i str-md)) (while (and (eq (strlen (setq md (substr str-md 1 4))) 4) (not one_o)) (repeat 3 (setq rap (/ (getvar "viewsize") n) 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)) pt5 (list (car pt) (- (cadr pt) rap) (caddr pt)) pt6 (list (+ (car pt) rap) (cadr pt) (caddr pt)) pt7 (list (car pt) (+ (cadr pt) rap) (caddr pt)) pt8 (list (- (car pt) rap) (cadr pt) (caddr pt)) pt56 (polar pt (- (/ pi 4.0)) rap) pt67 (polar pt (/ pi 4.0) rap) pt78 (polar pt (- pi (/ pi 4.0)) rap) pt85 (polar pt (+ pi (/ pi 4.0)) rap) n (- n 16) ) (if (equal (osnap pt-i md) pt) (setq one_o T)) (cond ((and (eq "_end" md) one_o) (grdraw pt1 pt2 1) (grdraw pt2 pt3 1) (grdraw pt3 pt4 1) (grdraw pt4 pt1 1) ) ((and (eq "_mid" md) one_o) (grdraw pt1 pt2 1) (grdraw pt2 pt7 1) (grdraw pt7 pt1 1) ) ((and (eq "_cen" md) one_o) (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1) (grdraw pt5 pt7 7) (grdraw pt6 pt8 7) ) ((and (eq "_nod" md) one_o) (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1) (grdraw pt1 pt3 1) (grdraw pt2 pt4 1) ) ((and (eq "_qua" md) one_o) (grdraw pt5 pt6 1) (grdraw pt6 pt7 1) (grdraw pt7 pt8 1) (grdraw pt8 pt5 1) ) ((and (eq "_int" md) one_o) (grdraw pt1 pt3 1) (grdraw pt2 pt4 1) ) ((and (eq "_ins" md) one_o) (grdraw pt5 pt2 1) (grdraw pt2 pt6 1) (grdraw pt6 pt8 1) (grdraw pt8 pt4 1) (grdraw pt4 pt7 1) (grdraw pt7 pt5 1) ) ((and (eq "_per" md) one_o) (grdraw pt1 pt2 1) (grdraw pt1 pt4 1) (grdraw pt8 pt 1) (grdraw pt pt5 1) ) ((and (eq "_tan" md) one_o) (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1) (grdraw pt3 pt4 1) ) ((and (eq "_nea" md) one_o) (grdraw pt1 pt2 1) (grdraw pt2 pt4 1) (grdraw pt4 pt3 1) (grdraw pt3 pt1 1) ) ) ) (setq str-md (substr str-md 6) n (/ (cadr (getvar "screensize")) 5.0)) ) ) (defun c:rectang_cen ( / o mod ptx key pt_sup pt_inf l h f f2 e th w) (setq o (getvar "osmode")) (if (or (zerop o) (eq (boole 1 o 16384) 16384)) (setq mod "_none") (progn (setq mod "") (mapcar '(lambda (xi xs) (if (not (zerop (boole 1 o xi))) (if (zerop (strlen mod)) (setq mod (strcat mod xs)) (setq mod (strcat mod "," xs)) ) ) ) '(1 2 4 8 16 32 64 128 256 512) '("_end" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea") ) ) ) (initget 1 "COtes CHanfrein Elévation Raccord Hauteur Largeur _Dimensions Chamfer Elevation Fillet Thickness Width") (while (not (listp (setq ptx (getpoint "\nSpécifiez le point central ou [COtes/CHanfrein/Elévation/Raccord/Hauteur/Largeur]: ")))) (cond ((eq ptx "Dimensions") (setq l (getdist (strcat "\nSpécifiez la longueur des rectangles <" (rtos (getvar "USERR1")) ">:"))) (if l (setvar "USERR1" l) (setq l (getvar "USERR1"))) (setq h (getdist (strcat "\nSpécifiez la largeur des rectangles <" (rtos (getvar "USERR2")) ">:"))) (if h (setvar "USERR2" h) (setq h (getvar "USERR2"))) ) ((eq ptx "Chamfer") (setq f (getdist (strcat "\nSpécifiez l'écart du premier chanfrein des rectangles <" (rtos (getvar "CHAMFERA")) ">: "))) (if f (setvar "CHAMFERA" f)) (setq f2 (getdist (strcat "\nSpécifiez l'écart du deuxième chanfrein des rectangles <" (rtos (getvar "CHAMFERB")) ">: "))) (if f2 (setvar "CHAMFERB" f2)) (setvar "USERS1" "#CHAMFER") ) ((eq ptx "Elevation") (setq e (getdist (strcat "\nSpécifiez l'élévation des rectangles <" (rtos (getvar "ELEVATION")) ">: "))) (if e (setvar "ELEVATION" e)) ) ((eq ptx "Fillet") (setq f (getdist (strcat "\nSpécifiez le rayon du raccord des rectangles <" (rtos (getvar "FILLETRAD")) ">: ")) f2 nil) (if f (setvar "FILLETRAD" f)) (setvar "USERS1" "") ) ((eq ptx "Thickness") (setq th (getdist (strcat "\nSpécifiez la hauteur des rectangles <" (rtos (getvar "THICKNESS")) ">: "))) (if th (setvar "THICKNESS" th)) ) ((eq ptx "Width") (setq w (getdist (strcat "\nSpécifiez la largeur de ligne des rectangles <" (rtos (getvar "PLINEWID")) ">: "))) (if w (setvar "PLINEWID" w)) ) ) (initget 1 "COtes CHanfrein Elévation Raccord Hauteur Largeur _Dimensions Chamfer Elevation Fillet Thickness Width") ) (if (and (not l) (not h)) (progn (princ "\nSpécifiez un coin: \n") (while (and (not (member (setq key (grread T 4 0)) '((2 13) (2 32)))) (/= (car key) 3)) (cond ((eq (car key) 5) (setq pt_sup (cadr key) pt_inf (polar ptx (+ (angle ptx pt_sup) pi) (distance ptx pt_sup)) ) (redraw) (if (and (/= mod "_none") (osnap pt_sup mod)) (gr-osmode pt_sup mod) ) (grvecs (list 7 ptx pt_sup 7 pt_inf (list (car pt_sup) (cadr pt_inf)) 7 (list (car pt_sup) (cadr pt_inf)) pt_sup 7 pt_sup (list (car pt_inf) (cadr pt_sup)) 7 (list (car pt_inf) (cadr pt_sup)) pt_inf ) ) ) (T (setq pt_inf nil pt_sup nil)) ) ) (redraw) ) (setq pt_inf (list (- (car ptx) (/ l 2.0)) (- (cadr ptx) (/ h 2.0)) (caddr ptx)) pt_sup (list (+ (car ptx) (/ l 2.0)) (+ (cadr ptx) (/ h 2.0)) (caddr ptx)) ) ) (setq e (getvar "ELEVATION") th (getvar "THICKNESS") w (getvar "PLINEWID")) (if (eq (getvar "USERS1") "#CHAMFER") (setq f (getvar "CHAMFERA") f2 (getvar "CHAMFERB")) (setq f (getvar "FILLETRAD") f2 nil)) (cond ((and pt_inf pt_sup) (if (osnap pt_sup mod) (setq pt_sup (osnap pt_sup mod) pt_inf (polar ptx (+ (angle ptx pt_sup) pi) (distance ptx pt_sup)) ) ) (setvar "USERR1" (distance pt_inf (list (car pt_sup) (cadr pt_inf) (caddr pt_inf)))) (setvar "USERR2" (distance (list (car pt_sup) (cadr pt_inf) (caddr pt_sup)) pt_sup)) (setvar "osmode" 0) (setvar "cmdecho" 0) (command "_.rectangle") (cond ((and f f2) (command "_chamfer" f f2) ) ((and f (not f2)) (command "_fillet" f) ) ) (if e (command "_elevation" e)) (if th (command "_thickness" th)) (if w (command "_width" w)) (command pt_inf pt_sup) (setvar "osmode" o) (setvar "cmdecho" 1) (command "_.rotate" (entlast) "" "_none" ptx) ) ) (prin1) ) 2eme LOSANGE (defun gr-osmode (pt-i str-md / n pt md rap pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt56 pt67 pt78 pt85 one_o) (setq n (/ (cadr (getvar "screensize")) 5.0)) (setq pt (osnap pt-i str-md)) (while (and (eq (strlen (setq md (substr str-md 1 4))) 4) (not one_o)) (repeat 3 (setq rap (/ (getvar "viewsize") n) 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)) pt5 (list (car pt) (- (cadr pt) rap) (caddr pt)) pt6 (list (+ (car pt) rap) (cadr pt) (caddr pt)) pt7 (list (car pt) (+ (cadr pt) rap) (caddr pt)) pt8 (list (- (car pt) rap) (cadr pt) (caddr pt)) pt56 (polar pt (- (/ pi 4.0)) rap) pt67 (polar pt (/ pi 4.0) rap) pt78 (polar pt (- pi (/ pi 4.0)) rap) pt85 (polar pt (+ pi (/ pi 4.0)) rap) n (- n 16) ) (if (equal (osnap pt-i md) pt) (setq one_o T)) (cond ((and (eq "_end" md) one_o) (grdraw pt1 pt2 1) (grdraw pt2 pt3 1) (grdraw pt3 pt4 1) (grdraw pt4 pt1 1) ) ((and (eq "_mid" md) one_o) (grdraw pt1 pt2 1) (grdraw pt2 pt7 1) (grdraw pt7 pt1 1) ) ((and (eq "_cen" md) one_o) (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1) (grdraw pt5 pt7 7) (grdraw pt6 pt8 7) ) ((and (eq "_nod" md) one_o) (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1) (grdraw pt1 pt3 1) (grdraw pt2 pt4 1) ) ((and (eq "_qua" md) one_o) (grdraw pt5 pt6 1) (grdraw pt6 pt7 1) (grdraw pt7 pt8 1) (grdraw pt8 pt5 1) ) ((and (eq "_int" md) one_o) (grdraw pt1 pt3 1) (grdraw pt2 pt4 1) ) ((and (eq "_ins" md) one_o) (grdraw pt5 pt2 1) (grdraw pt2 pt6 1) (grdraw pt6 pt8 1) (grdraw pt8 pt4 1) (grdraw pt4 pt7 1) (grdraw pt7 pt5 1) ) ((and (eq "_per" md) one_o) (grdraw pt1 pt2 1) (grdraw pt1 pt4 1) (grdraw pt8 pt 1) (grdraw pt pt5 1) ) ((and (eq "_tan" md) one_o) (grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1) (grdraw pt3 pt4 1) ) ((and (eq "_nea" md) one_o) (grdraw pt1 pt2 1) (grdraw pt2 pt4 1) (grdraw pt4 pt3 1) (grdraw pt3 pt1 1) ) ) ) (setq str-md (substr str-md 6) n (/ (cadr (getvar "screensize")) 5.0)) ) ) (defun c:losange_dyn ( / o mod ptx key loop value pt_sup pt1 pt2 pt_ext pt3 a_dir l h f f2 e th w) (setq o (getvar "osmode")) (if (or (zerop o) (eq (boole 1 o 16384) 16384)) (setq mod "_none") (progn (setq mod "") (mapcar '(lambda (xi xs) (if (not (zerop (boole 1 o xi))) (if (zerop (strlen mod)) (setq mod (strcat mod xs)) (setq mod (strcat mod "," xs)) ) ) ) '(1 2 4 8 16 32 64 128 256 512) '("_end" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea") ) ) ) (initget 1 "COtes CHanfrein Elévation Raccord Hauteur Largeur _Dimensions Chamfer Elevation Fillet Thickness Width") (while (not (listp (setq ptx (getpoint "\nSpécifiez le point central du losange ou [COtes/CHanfrein/Elévation/Raccord/Hauteur/Largeur]: ")))) (cond ((eq ptx "Dimensions") (setq l (getdist (strcat "\nLongueur de la 1ère diagonale <" (rtos (getvar "USERR1")) ">:"))) (if l (setvar "USERR1" l) (setq l (getvar "USERR1"))) (setq h (getdist (strcat "\nLongueur de la 2ème diagonale <" (rtos (getvar "USERR2")) ">:"))) (if h (setvar "USERR2" h) (setq h (getvar "USERR2"))) ) ((eq ptx "Chamfer") (setq f (getdist (strcat "\nSpécifiez l'écart du premier chanfrein des losanges <" (rtos (getvar "CHAMFERA")) ">: "))) (if f (setvar "CHAMFERA" f)) (setq f2 (getdist (strcat "\nSpécifiez l'écart du deuxième chanfrein des losanges <" (rtos (getvar "CHAMFERB")) ">: "))) (if f2 (setvar "CHAMFERB" f2)) (setvar "USERS1" "#CHAMFER") ) ((eq ptx "Elevation") (setq e (getdist (strcat "\nSpécifiez l'élévation des losanges <" (rtos (getvar "ELEVATION")) ">: "))) (if e (setvar "ELEVATION" e)) ) ((eq ptx "Fillet") (setq f (getdist (strcat "\nSpécifiez le rayon du raccord des losanges <" (rtos (getvar "FILLETRAD")) ">: ")) f2 nil) (if f (setvar "FILLETRAD" f)) (setvar "USERS1" "") ) ((eq ptx "Thickness") (setq th (getdist (strcat "\nSpécifiez la hauteur des losanges <" (rtos (getvar "THICKNESS")) ">: "))) (if th (setvar "THICKNESS" th)) ) ((eq ptx "Width") (setq w (getdist (strcat "\nSpécifiez la largeur de ligne des losanges <" (rtos (getvar "PLINEWID")) ">: "))) (if w (setvar "PLINEWID" w)) ) ) (initget 1 "COtes CHanfrein Elévation Raccord Hauteur Largeur _Dimensions Chamfer Elevation Fillet Thickness Width") ) (if (and (not l) (not h)) (progn (setq pt_ext (getpoint ptx (strcat "\nSpécifiez l'extrémité de la 1ère diagonale <" (rtos (/ (getvar "USERR1") 2.0)) ">:"))) (if (null pt_ext) (progn (setq pt_ext (osnap (cadr (grread T)) mod)) (if pt_ext (setq pt_ext (polar ptx (angle ptx pt_ext) (/ (getvar "USERR1") 2.0)) l (distance ptx pt_ext) a_dir (angle ptx pt_ext) ) (setq a_dir (angle ptx (cadr (grread T))) pt_ext (polar ptx a_dir (/ (getvar "USERR1") 2.0)) ) ) ) (setq l (distance ptx pt_ext) a_dir (angle ptx pt_ext) ) ) (if l (setvar "USERR1" (* l 2.0)) (setq l (/ (getvar "USERR1") 2.0))) (setq pt1 (polar ptx (angle pt_ext ptx) l) loop T value "") (princ (strcat "\nSpécifiez l'extrémité de la 2ème diagonale <" (rtos (/ (getvar "USERR2") 2.0)) ">: ")) (while (and (setq key (grread T 4 0)) (/= (car key) 3) loop) (cond ((eq (car key) 5) (setq pt_sup (cadr key) pt2 (polar ptx (+ (angle ptx pt_ext) (/ pi 2.0)) (distance ptx pt_sup)) pt3 (polar ptx (- (angle ptx pt_ext) (/ pi 2.0)) (distance ptx pt_sup)) ) (redraw) (if (and (/= mod "_none") (osnap pt_sup mod)) (gr-osmode pt_sup mod) ) (grvecs (list 7 ptx pt_sup 7 pt1 pt2 7 pt2 pt_ext 7 pt_ext pt3 7 pt3 pt1 ) ) ) ((or (member key '((2 13) (2 32))) (eq (car key) 25)) (if (and (not (zerop (strlen value))) (or (eq (type (read value)) 'INT) (eq (type (read value)) 'REAL))) (setvar "USERR2" (* (read value) 2.0)) ) (setq pt2 (polar ptx (+ (angle ptx pt_ext) (/ pi 2.0)) (/ (getvar "USERR2") 2.0)) pt3 (polar ptx (- (angle ptx pt_ext) (/ pi 2.0)) (/ (getvar "USERR2") 2.0)) loop nil pt_sup nil ) (princ "\n") ) (T (if (eq (cadr key) 8) (progn (setq value (substr value 1 (1- (strlen value)))) (princ (chr 8)) (princ (chr 32)) ) (setq value (strcat value (chr (cadr key)))) ) (princ (chr (cadr key))) ) ) ) (redraw) ) (setq pt1 (list (- (car ptx) (/ l 2.0)) (cadr ptx) (caddr ptx)) pt2 (list (car ptx) (+ (cadr ptx) (/ h 2.0)) (caddr ptx)) pt_ext (list (+ (car ptx) (/ l 2.0)) (cadr ptx) (caddr ptx)) pt3 (list (car ptx) (- (cadr ptx) (/ h 2.0)) (caddr ptx)) ) ) (setq e (getvar "ELEVATION") th (getvar "THICKNESS") w (getvar "PLINEWID")) (if (eq (getvar "USERS1") "#CHAMFER") (setq f (getvar "CHAMFERA") f2 (getvar "CHAMFERB")) (setq f (getvar "FILLETRAD") f2 nil)) (cond ((and pt1 pt2 pt_ext pt3) (if (and pt_sup (osnap pt_sup mod)) (setq pt_sup (osnap pt_sup mod) pt2 (polar ptx (+ (angle ptx pt_ext) (/ pi 2.0)) (distance ptx pt_sup)) pt3 (polar ptx (- (angle ptx pt_ext) (/ pi 2.0)) (distance ptx pt_sup)) ) ) (setvar "USERR1" (distance pt1 pt_ext)) (setvar "USERR2" (distance pt2 pt3)) (setvar "cmdecho" 0) (command "_.undo" "_group") (setvar "osmode" 0) (command "_.pline" pt1 "_width" w w pt2 pt_ext pt3 "_close") (cond ((and f f2) (setvar "trimmode" 1) (command "_.chamfer" "_polyline" (entlast)) ) ((and f (not f2)) (setvar "trimmode" 1) (command "_.fillet" "_polyline" (entlast)) ) ) (if e (command "_.change" (entlast) "" "_properties" "_elevation" e "")) (if th (command "_.change" (entlast) "" "_properties" "_thickness" th "")) (setvar "osmode" o) (command "_.undo" "_end") (setvar "cmdecho" 1) (if (not a_dir) (command "_.rotate" (entlast) "" "_none" ptx)) ) ) (prin1) ) 3eme OVALE (defun c:ovale ( / o ptx lw el th pt_def cc1 cc2 pt1 pt2 pt3 pt4) (setq o (getvar "osmode")) (initget 1 "Largeur ELevation EPaisseur _Width Elevation Thickness") (while (not (listp (setq ptx (getpoint "\nSpécifiez le point central de l'ovale ou [Largeur/ELévation/EPaisseur]: ")))) (cond ((eq ptx "Width") (initget 4) (setq lw (getdist (strcat "\nSpécifiez la largeur de la polyligne <" (rtos (getvar "PLINEWID")) ">: "))) (if lw (setvar "PLINEWID" lw)) ) ((eq ptx "Elevation") (setq el (getdist (strcat "\nSpécifiez l'élévation de l'ovale <" (rtos (getvar "ELEVATION")) ">: "))) (if el (setvar "ELEVATION" el)) ) ((eq ptx "Thickness") (setq th (getdist (strcat "\nSpécifiez l'épaisseur de l'ovale <" (rtos (getvar "THICKNESS")) ">: "))) (if th (setvar "THICKNESS" th)) ) ) (initget 1 "Largeur ELevation EPaisseur _Width Elevation Thickness") ) (initget 1) (setq pt_def (getpoint ptx "\nSpécifiez l'extrémité de la Demi-Longueur de l'ovale: ")) (setq lg (/ (* (distance (list (car ptx) (cadr ptx)) (list (car pt_def) (cadr pt_def))) 2.0) 3.0)) (setq cc1 (polar (list (car ptx) (cadr ptx)) (angle ptx pt_def) (/ lg 2.0))) (setq cc2 (polar (list (car ptx) (cadr ptx)) (angle pt_def ptx) (/ lg 2.0))) (setq pt1 (polar cc1 (- (angle ptx pt_def) (/ pi 3.0)) lg)) (setq pt2 (polar cc1 (+ (angle ptx pt_def) (/ pi 3.0)) lg)) (setq pt3 (polar cc2 (- (angle pt_def ptx) (/ pi 3.0)) lg)) (setq pt4 (polar cc2 (+ (angle pt_def ptx) (/ pi 3.0)) lg)) (setvar "osmode" 0) (setvar "cmdecho" 0) (command "_.pline" pt1 "_arc" "_ce" cc1 pt2 pt3 pt4 "_close") (setvar "osmode" o) (setvar "cmdecho" 1) (prin1) ) [Edité le 31/1/2005 par bonuscad] [Edité le 31/1/2005 par bonuscad]

Salut, Dans autocad, tu vas dans le gestionnaire de tracage, tu ouvre traceur que tu veux modifier. Tu vas sur l'onglet "Paramètres du périphérique et du document" Tu devrais trouver un module "Calibrage du traceur". Et tu as le bouton "Aide" , si tu es perdu ;)

Suivant le valeur de la variable "WORLDVIEW " les commandes "3DORBITE" "VUEDYN" et "POINTVUE" font référence au SCG ou au SCU. Voir l'aide.

Salut, Un truc dans ce style! (defun c:ins_mm2inch ( / bloc-name pt_ins ang_ins pt_ang) (setvar "cmdecho" 0) (setq bloc-name (getfiled "Sélectionner un dessin comme bloc" "" "dwg" 8)) (initget 1) (setq pt_ins (getpoint "\nSpécifiez le point d'insertion: ")) (setq ang_ins (getorient pt_ins "\nSpécifiez l'angle de rotation <0>: ")) (if (not ang_ins) (setq ang_ins 0.0)) (setq pt_ang (polar pt_ins ang_ins (cvunit 1 "millimeter" "inch"))) (command "_.-insert" bloc-name pt_ins (cvunit 1 "millimeter" "inch") (cvunit 1 "millimeter" "inch") pt_ang) (setvar "cmdecho" 1) (prin1) ) Voir le fichier "ACAD.UNT" dans le dossier support pour définir les autres modes possible de (cvunit) tu pourras te constituer un bouton sous la forme: ^C^C(if (not c:ins_mm2inch) (load"ins_mm2inch")) ins_mm2inch

Bravo Ludwig, Je l'ai essayé, ça fonctionne, sauf dans un cas (je suis tombé dessus).:( Pour ton info: Si le bloc est sur un calque verrouillé, la procédure s'execute sans aucune erreur, mais rien ne se passe après un "regen" . C'est ce qui est le plus pénible en programmation, envisager tout les cas de figure. En tout cas tu as déjà fait un joli boulot

Bien qu'e n'ayant pus essayer, je n'ai pas de fichier tel.;) Je me demande si ce logiciel "A3CAD" ne serait pas capable aussi d'éliminer la bannière "Educative" d'un fichier. Cela répondrait à une question qui revient souvent. Si quelqu'un pouvait faire le test et confirmer mon intuition !!! En tout cas il est super pour pouvoir convertir un 2004 en 2002.

Ludwig, Je me suis penché sur ce mode de sélection "Implicite" avec 2002 J'ai essayé l'exemple "tout bête" de l'aide: (ssget "_I" '((0 . "LINE") (62 . 5))) et bien déception! Ca ne fonctionne même pas, il me garde toute la sélection faite par PICKFIRST(qui ne correspond pas au filtre). Une méthode que j'ai réussi à faire fonctionner (avec 2002; je le rapelle) est, pour ton cas: (sssetfirst (ssget "_I" '((8 . "*B$*"))) (ssget "_I" '((8 . "*B$*")))) Voilà si ça peut t'aider à confectionner ta macro. Faut-il faire comme cela?, ça reste une question. Bruno V.

J'allais le dire Patrick_35 ;) (cond ((/= (cdr (assoc 62 n)) 0) (setq n (subst (cons 62 0) (assoc 62 n) n)) (entmod n) ) ((null (assoc 62 n)) (setq n (append (cons 62 0) n)) (entmod n) ) )

Si tu veux absolument utilisé (burst) qui est interressant pour les attribut en texte., mais délicat a appelé d'une autre fonction, car les appels interdépendant des express sont de véritable casse-tête. toujours est-il que tu peux remplacer: (setq JEU (ssget "x" '((0 . "INSERT")(410.LAYOUT)))) ->FAUX par (setq JEU (ssget "x" (cons '(0 . "INSERT") (list (cons 410 LAYOUT))))) et supprimer ta boucle (while .....) en ne conservant que les lignes: (sssetfirst nil JEU) (c:burst) (setq C (+ C NB)) De cette manière la routine à l'air de fonctionner, mais j'ai l'impression que plusieurs passes seront necessaires. NB: Il Semble avoir des problème si les blocs font parti de groupe.

Salut, J'ai l'impression que c'est manque de pas de chance! Tu as choisi l'option (ssget "_I") qui est la seule qui ne répond pas au modèle de ton filtre. Bien que je n'ai pas trouvé d'aide et/ou d'exemple sur ce mode de séléction, je pense que si un filtre est fourni, il ne s'applique pas à la sélection faite par "PICKFIRST". Essaye de tourner ta macro d'une autre façon car la synthaxe de ton filtre est bonne et fonctionne avec les autres modes de (ssget)

Dessiner un rectangle en definissant le centre (intersection des diagonales) et son encombrement en dynamique. Imperfection de la routine: *Les dimensions ne peuvent pas être entrées aux clavier. *L'accroche objet, bien qu'effectif, ne peut se voir lors du dimensionnement en dynamique. NB: Les précédents paramètres de rectangle [Chanfrein/Elévation/Raccord/Hauteur/Largeur] sont repris mais ne peuvent pas être modifiés (defun c:rectang_cen ( / o mod ptx key pt_sup pt_inf) (setq o (getvar "osmode")) (if (or (zerop o) (eq (boole 1 o 16384) 16384)) (setq mod "_none") (progn (setq mod "") (mapcar '(lambda (xi xs) (if (not (zerop (boole 1 o xi))) (if (zerop (strlen mod)) (setq mod (strcat mod xs)) (setq mod (strcat mod "," xs)) ) ) ) '(1 2 4 8 16 32 64 128 256 512 2048 4096 8192) '("_endp" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea" "_appint" "_ext" "_par") ) ) ) (initget 1) (setq ptx (getpoint "\nPoint central du rectangle: ")) (princ (strcat "\nSpécifiez un coin à [" mod "] de: \n")) (while (and (not (member (setq key (grread T 4 0)) '((2 13) (2 32)))) (/= (car key) 3)) (cond ((eq (car key) 5) (setq pt_sup (cadr key) pt_inf (polar ptx (+ (angle ptx pt_sup) pi) (distance ptx pt_sup)) ) (redraw) (grvecs (list 7 ptx pt_sup 7 pt_inf (list (car pt_sup) (cadr pt_inf)) 7 (list (car pt_sup) (cadr pt_inf)) pt_sup 7 pt_sup (list (car pt_inf) (cadr pt_sup)) 7 (list (car pt_inf) (cadr pt_sup)) pt_inf ) ) ) (T (setq pt_inf nil pt_sup nil)) ) ) (redraw) (cond ((and pt_inf pt_sup) (if (osnap pt_sup mod) (setq pt_sup (osnap pt_sup mod) pt_inf (polar ptx (+ (angle ptx pt_sup) pi) (distance ptx pt_sup)) ) ) (setvar "osmode" 0) (setvar "cmdecho" 0) (command "_.rectangle" pt_inf pt_sup) (setvar "osmode" o) (setvar "cmdecho" 1) (command "_.rotate" (entlast) "" ptx) ) ) (prin1) )

Exemple de montage: (defun mon_err (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") (if (<= sv_undo 3) (command "_.undo" "_control" "_one")) (setvar "OSMODE" sv_var1) (setvar "ATTDIA" sv_var2) (setq *error* olderr) (princ) ) (defun C:MA-Fonction ( / olderr sv_undo sv_var1 sv_var2) (setq olderr *error* *error* mon_err)on redéfini la fonction erreur standard avec la fonction mon_err (if (<= (setq sv_undo (getvar "undoctl")) 3) (command "_.undo" "_control" "_all") ) (command "_.undo" "_group") (setq sv_var1 (getvar "OSMODE") sv_var2 (getvar "ATTDIA")) On sauve l'état des variables initial ;..... ;Corps de la routine avec par exemple plusieurs appels à (command) et modification des variables OSMODE et ATTDIA ;..... (setvar "OSMODE" sv_var1)on restore l'état des variables (setvar "ATTDIA" sv_var2) (command "_.undo" "_end") (if (<= sv_undo 3) (command "_.undo" "_control" "_one")) (setq *error* olderr)on remet la fonction *error* standard (princ) ) Si pendant l'execution du corps de la routine l'utilisateur annule la routine par Echap [ESC] la fonction (mon_err) sera executé avant de retourné a la ligne de commande. De ce fait l'état initial sera restoré, ca ne serait pas le cas si la fonction mon_err n'etait pas définie. OSMODE ATTDIA et le mode de fonctionnement de UNDO seraient modifiés et pourrait pertuber un utilisateur non-averti et énerver un utilisateur plus averti. Cet une démarche qu'on doit adopter si l'on diffuse ses applications Faite ce que je dis, ne faites pas ce que je fais ;)

Ludwig, Sans avoir testé, pourquoi ne ferais tu pas ta sélection au préalable par exemple avec (ssget "_X" '((410 . "Model"))) ce qui pourrait donner: ^C^C_.Select;(ssget "_X" '((410 . "Model")));;-overkill;_previous;;f;0.001;i;.;p;y;t;y;e;y;; En effet overkill etant une fonction lisp , tu ne peut réentrer dans le lisp en cours d'execution avec (ssget)

On se demande comment AutoCAd interprète cette commande, c'est déroutant!!! Je vous laisse juger... Commande: (getcname "CENTRE") "_CENTRE" Commande: (getcname "_CENTRE") "CENTRE" Commande: (getcname "_CENTER") "CENTER" Commande: (getcname "CENTER") "_CENTER" D'après la fonction Lisp en 2002 (getcname), CENTRE et CENTER sont bien des commandes valides puisqu'elle retourne la traduction. L'options "Centre" des commandes sont toutes aussi aléatoirement interprétée Ex: Commande: arc Spécifiez le point de départ de l'arc ou [Centre]: Centre => priorité de l'option Accrobj à "centre de". de Non Centre introuvable(s) pour le point spécifié. Point ou option nécessaire. Spécifiez le point de départ de l'arc ou [Centre]: Ce Spécifiez le centre de l'arc: Spécifiez le point de départ de l'arc: Spécifiez l'extrémité de l'arc ou [Angle/Longueur de corde]: Par contre pour: Commande: texte Style de texte courant: "Standard" Hauteur de texte: 2.5000 Spécifiez le point de départ du texte ou [Justifier/Style]: justifier Entrez une option [Aligne/Fixé/Centre/Milieu/Droite/HG/HC/HD/MG/MC/MD/BG/BC/BD]: Centre => priorité de l'option Centre de la commande. Spécifiez le centre du texte: Spécifiez la hauteur <2.5000>: Spécifiez l'angle de rotation du texte <0>: Entrez le texte: CadXp Entrez le texte:

Bonjour, Je pense avoir compris que tes points sont en 2D et que tu veux les passer en 3D en récupérant la valeur du texte qui figure à coté (en cm). Voici un début d'exemple: (defun c:def_z ( / pt dxf_pt txt dxf_txt dxf_10 z pt_3d) (while (not (setq pt (entsel "\nChoix du point")))) (cond ((eq (cdr (assoc 0 (setq dxf_pt (entget (car pt))))) "POINT") (while (not (setq txt (entsel "\nChoix du texte :")))) (cond ((eq (cdr (assoc 0 (setq dxf_txt (entget (car txt))))) "TEXT") (setq z (/ (atof (cdr (assoc 1 dxf_txt))) 100.0)) (setq dxf_10 (cdr (assoc 10 dxf_pt))) (setq pt_3d (list (car dxf_10) (cadr dxf_10) z)) ) (T (princ " Ce n'est pas du texte!")) ) ) (T (princ " Ce n'est pas un point!")) ) (print pt_3d) (prin1) ) PS: tu aurait du poster dans le forum Lisp

Tu as du te "louper" quelque part, car j'ai essayer ton code sous 2002 en le corrigeant et cela à fonctionner sur une grille de ligne horzontale et verticale. Je te donne la correction en te prévenant que j'ai inactivé les fonctions (G_sauve_VAR), (G_restaure_GLOBAL) et (G_restaure_VAR) car je ne les posède pas. NB:Patrick_35 a raison: ce n'est qu'un problème de traduction (defun c:coupres ( / valcoup ensh ensv ens nb cpt data ent pt1 pt2 direction entdir nbh nbv cpth cptv p1h p2h nomv datav nomh datah p1v p2v lstpih lstpiv lstdr ssptr pti pc1 pc2 entcp datacp) ;Initialisation de la fonction de gestion des erreurs (setq AW_OLD_ERROR *error* *error* U_error) ; (G_sauve_VAR '("celtype" "cecolor" "clayer" "cmdecho" "blipmode" "aflags" "attreq" "orthomode")) (mapcar 'setvar '("cmdecho" "blipmode" "aflags" "attreq" "orthomode") '( 0 0 0 0 0 )) (command "_.osnap" "_none") (setq valcoup (getdist "\nEspacement <2.5> : ")) (if (null valcoup) (setq valcoup 2.5)) (setq ensh (ssadd)) (setq ensv (ssadd)) (princ "\nSelection du reseau...") (setq ens (ssget (list (cons 0 "LINE")))) (if ens (progn ;recuperation des lignes verticales et horizontales (setq nb (sslength ens)) (setq cpt 0) (while (< cpt nb) (setq ent (ssname ens cpt)) (setq data (entget ent)) (setq pt1 (cdr (assoc 10 data))) (setq pt2 (cdr (assoc 11 data))) (if (= (car pt1) (car pt2)) (setq ensv (ssadd ent ensv)) ) (if (= (cadr pt1) (cadr pt2)) (setq ensh (ssadd ent ensh)) ) (setq cpt (+ 1 cpt)) ) ) ) (if (or (= (sslength ensh) 0) (= (sslength ensv) 0)) ; ALORS (alert "Mauvais choix...Aucune intersection !") ; SINON...avec plusieurs instructions (progn (princ "\nDirection des coupures...") (setq direction nil) (setq entdir (car (entsel))) (if entdir (progn (cond ((ssmemb entdir ensh) (setq direction "HOR") ) ((ssmemb entdir ensv) (setq direction "VER") ) (T (setq direction nil) ) ) ) ) ) ) (if (null direction) (progn (if (not (or (= (sslength ensh) 0) (= (sslength ensv) 0))) (alert "\n\nMauvais choix dans la direction !") ) ) (progn ;recuperation des points d'intersection entre les horizontales et les verticales (setq nbh (sslength ensh)) (setq nbv (sslength ensv)) (setq cpth 0) (while (< cpth nbh) (setq nomh (ssname ensh cpth)) (setq datah (entget nomh)) (setq p1h (cdr (assoc 10 datah))) (setq p2h (cdr (assoc 11 datah))) (setq cptv 0) (while (< cptv nbv) (setq nomv (ssname ensv cptv)) (setq datav (entget nomv)) (setq p1v (cdr (assoc 10 datav))) (setq p2v (cdr (assoc 11 datav))) (if (setq pti (inters p1v p2v p1h p2h)) ; Instruction pour le ALORS du SI (progn (setq lstpih (cons (list pti nomh) lstpih)) (setq lstpiv (cons (list pti nomv) lstpiv)) ) ; Instructions pour le SINON du SI (progn ) ) (setq cptv (+ 1 cptv)) ) (setq cpth (+ 1 cpth)) ) (if (= direction "HOR") (setq lstdr lstpih) (setq lstdr lstpiv) ) (foreach ssptdr lstdr (setq pti (car ssptdr)) (setq ent (cadr ssptdr)) (cond ((= direction "HOR") (setq pc1 (list (- (car pti) valcoup) (cadr pti))) (setq pc2 (list (+ (car pti) valcoup) (cadr pti))) ) ((= direction "VER") (setq pc1 (list (car pti) (- (cadr pti) valcoup))) (setq pc2 (list (car pti) (+ (cadr pti) valcoup))) ) ) ; (command "_.break" (list ent pti) "_first" pc1 pc2) (setq entcp (ssget pc1)) (if entcp (progn (setq entcp (ssname entcp 0)) (setq datacp (entget entcp)) (if (= (cdr (assoc 0 datacp)) "LINE") (command "_.break" pc1 "_first" pc1 pc2) ) ) ) ) ) ) ;Restitution du contexte ; (G_restaure_GLOBAL) ; (G_restaure_VAR) (setq *error* AW_OLD_ERROR) (princ) ) (princ "\tcoupres charge.") (princ)

Bien pratique n'est ce pas? Dans le même registre tu as la commande (transparente) CONVESPACE ('_spacetrans) Je pense d'ailleur que la cotation utilise cette convertion D'ailleur si tu change le zoom de ta fenêtre , tu peut faire une mise à jour des cotations dans l'EPqui suivront alors ton objet dans l'EO.

Non, Bien que j'ai mofifié (pour moi) acetlayr.lsp desExpress pour inclure ces fonctions, je veux pas enfeindre le copyright en le diffusant. Je te propose une alternative en macro (fonctionne aussi sous une LT) Place cette ligne dans un bouton pour geler/liberer ^C^C^P$M=$(if,$(=,$(getvar,useri2),1),'useri2;0;_.-layer;_thaw;*;;,'useri2;1;_.-layer;_freeze;*;;)^Z et cette autre pour eteindre/allumer ^C^C^P$M=$(if,$(=,$(getvar,useri1),1),'useri1;0;_.-layer;_on;*;;,'useri1;1;_.-layer;_off;*;_no;;)^Z

Est ce que ceci est interressant? http://www.drcauto.com/slingshot/ Je n'ai pas testé j'ai une version pleine.

L'option "Multiple" sert justement à obtenir l'application de transformation sur TOUTES les lignes sélectionnées. Si tu veux faire ça que sur un calque précis utilise la commande "'_FILTER" au message "Choix des Objets". Je pense que tu as besoin quand même d'une formation de base ;)

Commande "PEDIT" option "Multiple" Choisir tes lignes Répondre "Oui" pour les convetir en polyligne option "Epaisseur" Donne la largeur voulue pour tes segments Et voilà!

Serge, J'utilise plutôt ce genre de procédure: (if (<= (setq sv_und (getvar "undoctl")) 3) (command "_.undo" "_control" "_all") ) (command "_.undo" "_begin") ou _group qui fonctionne aussi ..... ...... (command "_.undo" "_end") (if (<= sv_und 3) (command "_.undo" "_control" "_one")) En effet si undoctl< 3 , _undo _auto _off sera refusé Ce cas est extrème je le reconnais, mais est possible En règle générale je pense qu'on peut se contenter de _begin et _end car peu d'utilisateur vont modifier le comportement de l'annulation. Mais il m'es quand mêm arrivé d'utiliser, sur de très très gros fichier, Annuler sur aucun pour des traitements par lisp pour éviter d'avoir les fichiers temporaires $UNDO.AC$ (de mémoire) qui me fasse exploser l'espace disque. (bien sûr c'était au temps où l'espace disque et mémoire était beaucoup plus précieux)