x13

Voiçi un lisp qui va peut-être t'aider, ;; Pipe Text Marker by Lee McDonnell 13.04.2009 ;;; Updated 30.07.2009 (Lee McDonnell) (defun c:pipetxt (/ *error* CANG COBJ CPT DIAM DOC GR LANG LENT LEPT LLEN LMID LSLP LSPT MANHOL MSG OSPT OVAR PT SCL SPC TBOX TOBJ TSTR TSZE TWID VLST WBSE XDIS) (vl-load-com) (defun *error* (msg) (if doc (vla-EndUndoMark doc)) (if ovar (mapcar 'setvar vlst ovar)) (and tObj (not (vlax-erased-p tObj)) (vla-delete tObj)) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\n** Error: " msg " **")) (princ "\n*Cancel*")) (redraw) (princ)) (setq vlst '("CLAYER" "DIMZIN") ovar (mapcar 'getvar vlst)) (mapcar 'setvar (cdr vlst) '(1)) (if (eq 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar "CLAYER")))))) (progn (princ "\n<< Current Layer Locked >>") (exit))) (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object)) spc (if (zerop (vla-get-activespace doc)) (if (= (vla-get-mspace doc) :vlax-true) (vla-get-modelspace doc) (vla-get-paperspace doc)) (vla-get-modelspace doc))) (or (tblsearch "LAYER" "TXT-100") (vla-add (vla-get-layers doc) "TXT-100")) (or (and (zerop (getvar "DIMSCALE")) (setq scl 1.0)) (setq scl (getvar "DIMSCALE"))) (or pip:dia (setq pip:dia 8)) (or man:hol (setq man:hol 10.96)) (or *Mac$Per* (setq *Mac$Per* (/ pi 2.))) (or *Mac$tOff* (setq *Mac$tOff* 1.)) (initget 6) (or (not (setq diam (getreal (strcat "\nSpécifez le diamètre du tuyau <" (rtos pip:dia 2 0) "\">: ")))) (setq pip:dia diam)) (initget 6) (or (not (setq manhol (getreal (strcat "\nSpécifiez diamètre du regard <" (rtos man:hol 2 2) "'>: ")))) (setq man:hol manhol)) (while (and (setq lEnt (car (entsel "\nSélectionnez le tuyau: "))) (eq "LINE" (cdadr (entget lEnt)))) (setq cObj (vlax-ename->vla-object lEnt) lSpt (vlax-curve-getStartPoint cObj) lEpt (vlax-curve-getEndPoint cObj) lAng (angle lSpt lEpt) xdis (- (car lEpt) (car lSpt))) (if (zerop xdis) (setq lSlp "-") (setq lSlp (rtos (/ (- (cadr lEpt) (cadr lSpt)) (* 10.0 xdis)) 2 3))) (setq lLen (+ (abs (- (car lEpt) (car lSpt))) man:hol) lMid (vlax-curve-getPointatParam cObj (/ (vlax-curve-getEndParam cObj) 2.0))) (setq tStr (strcat (rtos lLen 2 0) " L.F. OF " (rtos pip:dia 2 0) "\"%%C P.V.C. @ " lSlp " SLOPE (" (rtos (* (distof lSlp 2) 100.) 2 2) "%)") tSze (* 0.1 scl)) (setq tBox (textbox (list (cons 1 (strcat tStr "..")) (cons 40 tSze) (cons 7 (getvar "TEXTSTYLE")))) wBse (textbox (list (cons 1 ".") (cons 40 tSze) (cons 7 (getvar "TEXTSTYLE")))) wBse (- (caadr wBse) (caar wBse))) (vla-put-attachmentpoint (setq tObj (vla-addMText spc (vlax-3D-point '(0 0 0)) (setq tWid (- (caadr tBox) (caar tBox))) tStr)) acAttachmentPointMiddleCenter) (vla-put-Height tObj tSze) (vla-put-layer tObj "TXT-100") (setq msg (princ "\n<< Tapez [+] or [-] pourr offset, [P]er & [<] ou [>] pour MText Width >>")) ;; Place Text (while (progn (setq gr (grread t 15 0)) (redraw) (cond ((and (eq 5 (car gr)) (listp (setq cPt (cadr gr)))) (setq pt (vlax-curve-getClosestPointto cObj cPt)) (if (and (< 0 (getvar "OSMODE") 16383) (setq osPt (osnap pt (osLst (getvar "OSMODE"))))) (osMark osPt)) (setq cAng (angle pt cPt) lAng (+ cAng *Mac$Per*)) ;; Correct Angle (cond ((and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (vla-move tObj (vla-get-InsertionPoint tObj) (vlax-3D-point (polar pt cAng (* tSze *Mac$tOff*)))) (vla-put-Rotation tObj lAng) t) ((eq 2 (car gr)) (cond ((vl-position (cadr gr) '(43 61)) (setq *Mac$tOff* (+ (/ 1 10.) *Mac$tOff*))) ((eq (cadr gr) 45) (setq *Mac$tOff* (- *Mac$tOff* (/ 1 10.)))) ((eq 6 (cadr gr)) (cond ((< 0 (getvar "OSMODE") 16384) (setvar "OSMODE" (+ 16384 (getvar "OSMODE"))) (princ (strcat "\n" msg))) (t (setvar "OSMODE" (- (getvar "OSMODE") 16384)) (princ (strcat "\n" msg)))) t) ((vl-position (cadr gr) '(80 112)) (setq *Mac$Per* (- (/ pi 2.) *Mac$Per*))) ((vl-position (cadr gr) '(60 44)) (if (> (- (vla-get-Width tObj) wBse) 0) (vla-put-Width tObj (- (vla-get-Width tObj) wBse))) t) ((vl-position (cadr gr) '(62 46)) (vla-put-Width tObj (+ (vla-get-Width tObj) wBse)) t) ((vl-position (cadr gr) '(13 32)) nil) (t))) ((eq 3 (car gr)) (if (and (< 0 (getvar "OSMODE") 16383) (setq osPt (osnap pt (osLst (getvar "OSMODE"))))) (progn (osMark osPt) (setq cAng (angle pt cPt) lAng (+ cAng *Mac$Per*)) ;; Correct Angle (cond ((and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi))) ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi)))) (vla-move tObj (vla-get-InsertionPoint tObj) (vlax-3D-point (polar ospt cAng (* tSze *Mac$tOff*)))) (vla-put-Rotation tObj lAng))) nil) ((eq 25 (car gr)) nil) (t))))) (mapcar 'setvar vlst ovar) (redraw) (princ)) (princ "\n.: PipeText chargé, tapez \"Pipetxt\" pour démarrer :.") (princ) (defun oSlst (os / str cnt) (setq str "" cnt 0) (if (< 0 os 16383) (foreach mod '("_end" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea" "_non" "_app" "_ext" "_par") (if (not (zerop (logand (expt 2 cnt) os))) (setq str (strcat str mod (chr 44)))) (setq cnt (1+ cnt)))) (vl-string-right-trim (chr 44) str)) (defun osMark (pt / drft osSz osCol ratio bold glst i) (setq drft (vla-get-drafting (vla-get-preferences (vlax-get-acad-object))) osSz (vla-get-AutoSnapMarkerSize drft) oscol (vla-get-AutoSnapMarkerColor drft) ratio (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))) bold (mapcar (function (lambda (x) (* x ratio))) (list (+ osSz 0.5) osSz (- osSz 0.5))) i 0) (repeat 50 (setq glst (cons (polar '(0 0 0) (* i (/ pi 25.)) 1.) glst) i (1+ i))) (foreach x bold (grvecs (append (list oscol) glst (cdr glst) (list (car glst))) (list (list x 0.0 0.0 (car pt)) (list 0.0 x 0.0 (cadr pt)) (list 0.0 0.0 1.0 0.0) (list 0.0 0.0 0.0 1.0))))) Salut, :)

Bonjour, Sur la bordure de la cartouche de mes gabarits j'ai du Rtext et il n'apparait plus. Je retrouve plutôt un rectangle avec un X à l'intérieur. Lorsque je le sélectione et va voir les propriétés, il est dit que c'est un Acad_Proxy_entity. Qu'est-ce que cela signifie et comment rétablir le Rtext. Merçi de votre aide.

L'origine du lisp , http://www.gregmacg.com/Autolisp.html :)

À part MSproject il y a http://sourceforge.net/projects/ganttproject/ Pour le lisp celui-ci peut sûrement être amélioré. ; ; DDGANTT.LSP 2.0 © Greg MacGeorge, May 2000 ; (defun wline () (setq v 5) (repeat 4 (setq xwk (+ 8.75 (* v incr) premx)) (setq xwkpt (list xwk liney)) (setq pt1 (polar xwkpt 0 0)) (setq pt2 (polar pt1 1.5707963 0.25)) (command "line") (command pt1) (command pt2) (command "") (setq txtwk (list xwk wtexty)) (command "text") (command "c" txtwk ".125" "0" v) (setq v (+ v 7)) ) (command "setvar" "cmdecho" 1) ) ; ; (defun mon () (command "setvar" "cmdecho" 0) (setq xmon (+ 8.75 endmx)) (setq monpt (list xmon liney)) (setq monpt2 (list xmon liney2)) (setq pt1 (polar monpt 0 0)) (setq pt2 (polar pt1 1.5707963 1)) (command "line") (command pt1) (command pt2) (command "") (setq pt3 (polar monpt2 0 0)) (setq pt4 (polar pt3 4.712389 18.75)) (command "line") (command pt3) (command pt4) (command "") (setq txtmon (/ (- endmx premx) 2)) (setq txtmon (+ txtmon premx)) (setq txtmon (+ 8.75 txtmon)) (setq txtmonpt (list txtmon mtexty)) ) ; ; (defun jan1 () (command "text") (command "c" txtmonpt "0.1875" "0" "Janvier") (wline) ) ; ; ; ; (defun fev1 () (command "text") (command "c" txtmonpt "0.1875" "0" "Fevrier") (wline) ) ; ; ; ; (defun mar1 () (command "text") (command "c" txtmonpt "0.1875" "0" "Mars") (wline) ) ; ; ; ; (defun avr1 () (command "text") (command "c" txtmonpt "0.1875" "0" "Avril") (wline) ) ; ; ; ; (defun mai1 () (command "text") (command "c" txtmonpt "0.1875" "0" "Mai") (wline) ) ; ; ; ; (defun jun1 () (command "text") (command "c" txtmonpt "0.1875" "0" "Juin") (wline) ) ; ; ; ; (defun jul1 () (command "text") (command "c" txtmonpt "0.1875" "0" "Juillet") (wline) ) ; ; ; ; (defun aou1 () (command "text") (command "c" txtmonpt "0.1875" "0" "Aoust") (wline) ) ; ; ; ; (defun sep1 () (command "text") (command "c" txtmonpt "0.1875" "0" "Septembre") (wline) ) ; ; ; ; (defun oct1 () (command "text") (command "c" txtmonpt "0.1875" "0" "Octobre") (wline) ) ; ; ; ; (defun nov1 () (command "text") (command "c" txtmonpt "0.1875" "0" "Novembre") (wline) ) ; ; ; ; (defun dec1 () (command "text") (command "c" txtmonpt "0.1875" "0" "Decembre") (wline) ) ; ; ; ; (defun twmon1 () (setq incr (/ 24.375 365)) (setq premx 0) (setq endmx (* 31 incr)) (setq stmx1 (* 0 incr)) (mon) (jan1) (setq premx endmx) (setq endmx (* 59 incr)) (setq stmx2 (* 31 incr)) (mon) (fev1) (setq premx endmx) (setq endmx (* 90 incr)) (setq stmx3 (* 59 incr)) (mon) (mar1) (setq premx endmx) (setq endmx (* 120 incr)) (setq stmx4 (* 90 incr)) (mon) (avr1) (setq premx endmx) (setq endmx (* 151 incr)) (setq stmx5 (* 120 incr)) (mon) (mai1) (setq premx endmx) (setq endmx (* 181 incr)) (setq stmx6 (* 151 incr)) (mon) (jun1) (setq premx endmx) (setq endmx (* 212 incr)) (setq stmx7 (* 181 incr)) (mon) (jul1) (setq premx endmx) (setq endmx (* 243 incr)) (setq stmx8 (* 212 incr)) (mon) (aou1) (setq premx endmx) (setq endmx (* 273 incr)) (setq stmx9 (* 243 incr)) (mon) (sep1) (setq premx endmx) (setq endmx (* 304 incr)) (setq stmx10 (* 273 incr)) (mon) (oct1) (setq premx endmx) (setq endmx (* 334 incr)) (setq stmx11 (* 304 incr)) (mon) (nov1) (setq premx endmx) (setq endmx (* 365 incr)) (setq stmx12 (* 334 incr)) (mon) (dec1) ) ; ; ; ; (defun twmon2 () (setq incr (/ 24.375 365)) (setq premx 0) (setq endmx (* 28 incr)) (setq stmx2 (* 0 incr)) (mon) (fev1) (setq premx endmx) (setq endmx (* 59 incr)) (setq stmx3 (* 28 incr)) (mon) (mar1) (setq premx endmx) (setq endmx (* 89 incr)) (setq stmx4 (* 59 incr)) (mon) (avr1) (setq premx endmx) (setq endmx (* 120 incr)) (setq stmx5 (* 89 incr)) (mon) (mai1) (setq premx endmx) (setq endmx (* 150 incr)) (setq stmx6 (* 120 incr)) (mon) (jun1) (setq premx endmx) (setq endmx (* 181 incr)) (setq stmx7 (* 150 incr)) (mon) (jul1) (setq premx endmx) (setq endmx (* 212 incr)) (setq stmx8 (* 181 incr)) (mon) (aou1) (setq premx endmx) (setq endmx (* 242 incr)) (setq stmx9 (* 212 incr)) (mon) (sep1) (setq premx endmx) (setq endmx (* 273 incr)) (setq stmx10 (* 242 incr)) (mon) (oct1) (setq premx endmx) (setq endmx (* 303 incr)) (setq stmx11 (* 273 incr)) (mon) (nov1) (setq premx endmx) (setq endmx (* 334 incr)) (setq stmx12 (* 303 incr)) (mon) (dec1) (setq premx endmx) (setq endmx (* 365 incr)) (setq stmx1 (* 334 incr)) (mon) (jan1) ) ; ; ; ; (defun twmon3 () (setq incr (/ 24.375 365)) (setq premx 0) (setq endmx (* 31 incr)) (setq stmx3 (* 0 incr)) (mon) (mar1) (setq premx endmx) (setq endmx (* 61 incr)) (setq stmx4 (* 31 incr)) (mon) (avr1) (setq premx endmx) (setq endmx (* 92 incr)) (setq stmx5 (* 61 incr)) (mon) (mai1) (setq premx endmx) (setq endmx (* 122 incr)) (setq stmx6 (* 92 incr)) (mon) (jun1) (setq premx endmx) (setq endmx (* 153 incr)) (setq stmx7 (* 122 incr)) (mon) (jul1) (setq premx endmx) (setq endmx (* 184 incr)) (setq stmx8 (* 153 incr)) (mon) (aou1) (setq premx endmx) (setq endmx (* 214 incr)) (setq stmx9 (* 184 incr)) (mon) (sep1) (setq premx endmx) (setq endmx (* 245 incr)) (setq stmx10 (* 214 incr)) (mon) (oct1) (setq premx endmx) (setq endmx (* 275 incr)) (setq stmx11 (* 245 incr)) (mon) (nov1) (setq premx endmx) (setq endmx (* 306 incr)) (setq stmx12 (* 275 incr)) (mon) (dec1) (setq premx endmx) (setq endmx (* 337 incr)) (setq stmx1 (* 306 incr)) (mon) (jan1) (setq premx endmx) (setq endmx (* 365 incr)) (setq stmx2 (* 337 incr)) (mon) (fev1) ) ; ; ; ; (defun twmon4 () (setq incr (/ 24.375 365)) (setq premx 0) (setq endmx (* 30 incr)) (setq stmx4 (* 0 incr)) (mon) (avr1) (setq premx endmx) (setq endmx (* 61 incr)) (setq stmx5 (* 30 incr)) (mon) (mai1) (setq premx endmx) (setq endmx (* 91 incr)) (setq stmx6 (* 61 incr)) (mon) (jun1) (setq premx endmx) (setq endmx (* 122 incr)) (setq stmx7 (* 91 incr)) (mon) (jul1) (setq premx endmx) (setq endmx (* 153 incr)) (setq stmx8 (* 122 incr)) (mon) (aou1) (setq premx endmx) (setq endmx (* 183 incr)) (setq stmx9 (* 153 incr)) (mon) (sep1) (setq premx endmx) (setq endmx (* 214 incr)) (setq stmx10 (* 183 incr)) (mon) (oct1) (setq premx endmx) (setq endmx (* 244 incr)) (setq stmx11 (* 214 incr)) (mon) (nov1) (setq premx endmx) (setq endmx (* 275 incr)) (setq stmx12 (* 244 incr)) (mon) (dec1) (setq premx endmx) (setq endmx (* 306 incr)) (setq stmx1 (* 275 incr)) (mon) (jan1) (setq premx endmx) (setq endmx (* 334 incr)) (setq stmx2 (* 306 incr)) (mon) (fev1) (setq premx endmx) (setq endmx (* 365 incr)) (setq stmx3 (* 334 incr)) (mon) (mar1) ) ; ; ; ; (defun twmon5 () (setq incr (/ 24.375 365)) (setq premx 0) (setq endmx (* 31 incr)) (setq stmx5 (* 0 incr)) (mon) (mai1) (setq premx endmx) (setq endmx (* 61 incr)) (setq stmx6 (* 31 incr)) (mon) (jun1) (setq premx endmx) (setq endmx (* 92 incr)) (setq stmx7 (* 61 incr)) (mon) (jul1) (setq premx endmx) (setq endmx (* 123 incr)) (setq stmx8 (* 92 incr)) (mon) (aou1) (setq premx endmx) (setq endmx (* 153 incr)) (setq stmx9 (* 123 incr)) (mon) (sep1) (setq premx endmx) (setq endmx (* 184 incr)) (setq stmx10 (* 153 incr)) (mon) (oct1) (setq premx endmx) (setq endmx (* 214 incr)) (setq stmx11 (* 184 incr)) (mon) (nov1) (setq premx endmx) (setq endmx (* 245 incr)) (setq stmx12 (* 214 incr)) (mon) (dec1) (setq premx endmx) (setq endmx (* 276 incr)) (setq stmx1 (* 245 incr)) (mon) (jan1) (setq premx endmx) (setq endmx (* 304 incr)) (setq stmx2 (* 276 incr)) (mon) (fev1) (setq premx endmx) (setq endmx (* 335 incr)) (setq stmx3 (* 304 incr)) (mon) (mar1) (setq premx endmx) (setq endmx (* 365 incr)) (setq stmx4 (* 335 incr)) (mon) (avr1) ) ; ; ; ; (defun twmon6 () (setq incr (/ 24.375 365)) (setq premx 0) (setq endmx (* 30 incr)) (setq stmx6 (* 0 incr)) (mon) (jun1) (setq premx endmx) (setq endmx (* 61 incr)) (setq stmx7 (* 30 incr)) (mon) (jul1) (setq premx endmx) (setq endmx (* 92 incr)) (setq stmx8 (* 61 incr)) (mon) (aou1) (setq premx endmx) (setq endmx (* 122 incr)) (setq stmx9 (* 92 incr)) (mon) (sep1) (setq premx endmx) (setq endmx (* 153 incr)) (setq stmx10 (* 122 incr)) (mon) (oct1) (setq premx endmx) (setq endmx (* 183 incr)) (setq stmx11 (* 153 incr)) (mon) (nov1) (setq premx endmx) (setq endmx (* 214 incr)) (setq stmx12 (* 183 incr)) (mon) (dec1) (setq premx endmx) (setq endmx (* 245 incr)) (setq stmx1 (* 214 incr)) (mon) (jan1) (setq premx endmx) (setq endmx (* 273 incr)) (setq stmx2 (* 245 incr)) (mon) (fev1) (setq premx endmx) (setq endmx (* 304 incr)) (setq stmx3 (* 273 incr)) (mon) (mar1) (setq premx endmx) (setq endmx (* 334 incr)) (setq stmx4 (* 304 incr)) (mon) (avr1) (setq premx endmx) (setq endmx (* 365 incr)) (setq stmx5 (* 334 incr)) (mon) (mai1) ) ; ; ; ; (defun twmon7 () (setq incr (/ 24.375 365)) (setq premx 0) (setq endmx (* 31 incr)) (setq stmx7 (* 0 incr)) (mon) (jul1) (setq premx endmx) (setq endmx (* 62 incr)) (setq stmx8 (* 31 incr)) (mon) (aou1) (setq premx endmx) (setq endmx (* 92 incr)) (setq stmx9 (* 62 incr)) (mon) (sep1) (setq premx endmx) (setq endmx (* 123 incr)) (setq stmx10 (* 92 incr)) (mon) (oct1) (setq premx endmx) (setq endmx (* 153 incr)) (setq stmx11 (* 123 incr)) (mon) (nov1) (setq premx endmx) (setq endmx (* 184 incr)) (setq stmx12 (* 153 incr)) (mon) (dec1) (setq premx endmx) (setq endmx (* 215 incr)) (setq stmx1 (* 184 incr)) (mon) (jan1) (setq premx endmx) (setq endmx (* 243 incr)) (setq stmx2 (* 215 incr)) (mon) (fev1) (setq premx endmx) (setq endmx (* 274 incr)) (setq stmx3 (* 243 incr)) (mon) (mar1) (setq premx endmx) (setq endmx (* 304 incr)) (setq stmx4 (* 274 incr)) (mon) (avr1) (setq premx endmx) (setq endmx (* 335 incr)) (setq stmx5 (* 304 incr)) (mon) (mai1) (setq premx endmx) (setq endmx (* 365 incr)) (setq stmx6 (* 335 incr)) (mon) (jun1) ) ; ; ; ; (defun twmon8 () (setq incr (/ 24.375 365)) (setq premx 0) (setq endmx (* 31 incr)) (setq stmx8 (* 0 incr)) (mon) (aou1) (setq premx endmx) (setq endmx (* 61 incr)) (setq stmx9 (* 31 incr)) (mon) (sep1) (setq premx endmx) (setq endmx (* 92 incr)) (setq stmx10 (* 61 incr)) (mon) (oct1) (setq premx endmx) (setq endmx (* 122 incr)) (setq stmx11 (* 92 incr)) (mon) (nov1) (setq premx endmx) (setq endmx (* 153 incr)) (setq stmx12 (* 122 incr)) (mon) (dec1) (setq premx endmx) (setq endmx (* 184 incr)) (setq stmx1 (* 153 incr)) (mon) (jan1) (setq premx endmx) (setq endmx (* 212 incr)) (setq stmx2 (* 184 incr)) (mon) (fev1) (setq premx endmx) (setq endmx (* 243 incr)) (setq stmx3 (* 212 incr)) (mon) (mar1) (setq premx endmx) (setq endmx (* 273 incr)) (setq stmx4 (* 243 incr)) (mon) (avr1) (setq premx endmx) (setq endmx (* 303 incr)) (setq stmx5 (* 273 incr)) (mon) (mai1) (setq premx endmx) (setq endmx (* 334 incr)) (setq stmx6 (* 303 incr)) (mon) (jun1) (setq premx endmx) (setq endmx (* 365 incr)) (setq stmx7 (* 334 incr)) (mon) (jul1) ) ; ; ; ; (defun twmon9 () (setq incr (/ 24.375 365)) (setq premx 0) (setq endmx (* 30 incr)) (setq stmx9 (* 0 incr)) (mon) (sep1) (setq premx endmx) (setq endmx (* 61 incr)) (setq stmx10 (* 30 incr)) (mon) (oct1) (setq premx endmx) (setq endmx (* 91 incr)) (setq stmx11 (* 61 incr)) (mon) (nov1) (setq premx endmx) (setq endmx (* 122 incr)) (setq stmx12 (* 91 incr)) (mon) (dec1) (setq premx endmx) (setq endmx (* 153 incr)) (setq stmx1 (* 122 incr)) (mon) (jan1) (setq premx endmx) (setq endmx (* 181 incr)) (setq stmx2 (* 153 incr)) (mon) (fev1) (setq premx endmx) (setq endmx (* 212 incr)) (setq stmx3 (* 181 incr)) (mon) (mar1) (setq premx endmx) (setq endmx (* 242 incr)) (setq stmx4 (* 212 incr)) (mon) (avr1) (setq premx endmx) (setq endmx (* 273 incr)) (setq stmx5 (* 242 incr)) (mon) (mai1) (setq premx endmx) (setq endmx (* 303 incr)) (setq stmx6 (* 273 incr)) (mon) (jun1) (setq premx endmx) (setq endmx (* 334 incr)) (setq stmx7 (* 303 incr)) (mon) (jul1) (setq premx endmx) (setq endmx (* 365 incr)) (setq stmx8 (* 334 incr)) (mon) (aou1) ) ; ; ; ; (defun twmon10 () (setq incr (/ 24.375 365)) (setq premx 0) (setq endmx (* 31 incr)) (setq stmx10 (* 0 incr)) (mon) (oct1) (setq premx endmx) (setq endmx (* 61 incr)) (setq stmx11 (* 31 incr)) (mon) (nov1) (setq premx endmx) (setq endmx (* 92 incr)) (setq stmx12 (* 61 incr)) (mon) (dec1) (setq premx endmx) (setq endmx (* 123 incr)) (setq stmx1 (* 92 incr)) (mon) (jan1) (setq premx endmx) (setq endmx (* 151 incr)) (setq stmx2 (* 123 incr)) (mon) (fev1) (setq premx endmx) (setq endmx (* 182 incr)) (setq stmx3 (* 151 incr)) (mon) (mar1) (setq premx endmx) (setq endmx (* 212 incr)) (setq stmx4 (* 182 incr)) (mon) (avr1) (setq premx endmx) (setq endmx (* 243 incr)) (setq stmx5 (* 212 incr)) (mon) (mai1) (setq premx endmx) (setq endmx (* 273 incr)) (setq stmx6 (* 243 incr)) (mon) (jun1) (setq premx endmx) (setq endmx (* 304 incr)) (setq stmx7 (* 273 incr)) (mon) (jul1) (setq premx endmx) (setq endmx (* 335 incr)) (setq stmx8 (* 304 incr)) (mon) (aou1) (setq premx endmx) (setq endmx (* 365 incr)) (setq stmx9 (* 335 incr)) (mon) (sep1) ) ; ; ; ; (defun twmon11 () (setq incr (/ 24.375 365)) (setq premx 0) (setq endmx (* 30 incr)) (setq stmx11 (* 0 incr)) (mon) (nov1) (setq premx endmx) (setq endmx (* 61 incr)) (setq stmx12 (* 30 incr)) (mon) (dec1) (setq premx endmx) (setq endmx (* 92 incr)) (setq stmx1 (* 61 incr)) (mon) (jan1) (setq premx endmx) (setq endmx (* 120 incr)) (setq stmx2 (* 92 incr)) (mon) (fev1) (setq premx endmx) (setq endmx (* 151 incr)) (setq stmx3 (* 120 incr)) (mon) (mar1) (setq premx endmx) (setq endmx (* 181 incr)) (setq stmx4 (* 151 incr)) (mon) (avr1) (setq premx endmx) (setq endmx (* 212 incr)) (setq stmx5 (* 181 incr)) (mon) (mai1) (setq premx endmx) (setq endmx (* 242 incr)) (setq stmx6 (* 212 incr)) (mon) (jun1) (setq premx endmx) (setq endmx (* 273 incr)) (setq stmx7 (* 242 incr)) (mon) (jul1) (setq premx endmx) (setq endmx (* 304 incr)) (setq stmx8 (* 273 incr)) (mon) (aou1) (setq premx endmx) (setq endmx (* 334 incr)) (setq stmx9 (* 304 incr)) (mon) (sep1) (setq premx endmx) (setq endmx (* 365 incr)) (setq stmx10 (* 334 incr)) (mon) (oct1) ) ; ; ; ; (defun twmon12 () (setq incr (/ 24.375 365)) (setq premx 0) (setq endmx (* 31 incr)) (setq stmx12 (* 0 incr)) (mon) (dec1) (setq premx endmx) (setq endmx (* 62 incr)) (setq stmx1 (* 31 incr)) (mon) (jan1) (setq premx endmx) (setq endmx (* 90 incr)) (setq stmx2 (* 62 incr)) (mon) (fev1) (setq premx endmx) (setq endmx (* 121 incr)) (setq stmx3 (* 90 incr)) (mon) (mar1) (setq premx endmx) (setq endmx (* 151 incr)) (setq stmx4 (* 121 incr)) (mon) (avr1) (setq premx endmx) (setq endmx (* 182 incr)) (setq stmx5 (* 151 incr)) (mon) (mai1) (setq premx endmx) (setq endmx (* 212 incr)) (setq stmx6 (* 182 incr)) (mon) (jun1) (setq premx endmx) (setq endmx (* 243 incr)) (setq stmx7 (* 212 incr)) (mon) (jul1) (setq premx endmx) (setq endmx (* 274 incr)) (setq stmx8 (* 243 incr)) (mon) (aou1) (setq premx endmx) (setq endmx (* 304 incr)) (setq stmx9 (* 274 incr)) (mon) (sep1) (setq premx endmx) (setq endmx (* 335 incr)) (setq stmx10 (* 304 incr)) (mon) (oct1) (setq premx endmx) (setq endmx (* 365 incr)) (setq stmx11 (* 335 incr)) (mon) (nov1) ) ; ; ; ; ; (defun bordline () (command "setvar" "cmdecho" 0) (command "setvar" "limmin" "0,0") (command "setvar" "limmax" "36,24") (command "zoom" "a") (command "line") (command "0.625,0.625" "0.625,21.375" "33.125,21.375" "33.125,0.625" "close") (command "line") (command "8.625,21.375" "8.625,19.50" "0.625,19.50" "") (command "line") (command "0.625,19.375" "8.625,19.375" "8.625,0.625" "") (command "line") (command "8.75,21.375" "8.75,19.50" "33.125,19.50" "") (command "line") (command "33.125,19.375" "8.75,19.375" "8.75,0.625" "") (command "line") (command "8.75,20.50" "33.125,20.50" "") (command "setvar" "cmdecho" 1) ) ; ; ; ; (defun gan1 () (setq mtexty 20.1875) (setq wtexty 19.875) (setq liney 19.5) (setq liney2 19.375) (setq incr 1) (setq task "t") (setq task1 "t") (setq h "t") ) ; ; ; ; (defun gan2 () (setq chtyp (itoa smonth)) (if (= chtyp "0") (twmon1)) (if (= chtyp "1") (twmon2)) (if (= chtyp "2") (twmon3)) (if (= chtyp "3") (twmon4)) (if (= chtyp "4") (twmon5)) (if (= chtyp "5") (twmon6)) (if (= chtyp "6") (twmon7)) (if (= chtyp "7") (twmon8)) (if (= chtyp "8") (twmon9)) (if (= chtyp "9") (twmon10)) (if (= chtyp "10") (twmon11)) (if (= chtyp "11") (twmon12)) ) ; ; ; ; (defun ptask () (write-line task f) (command "setvar" "cmdecho" 0) (command "text") (command "r" tpt "0.25" "0" task) (command "setvar" "cmdecho" 1) (setq h nil) ) ; ; ; (defun ganhead_on () (if (= task 1) (progn (mode_tile "task" 1) (mode_tile "tstart_mon_list" 1) (mode_tile "tstart_day" 1) (mode_tile "tend_mon_list" 1) (mode_tile "tend_day" 1) (mode_tile "head" 0) (mode_tile "head" 2) ) (progn (mode_tile "task" 0) (mode_tile "task" 2) (mode_tile "tstart_mon_list" 0) (mode_tile "tstart_day" 0) (mode_tile "tend_mon_list" 0) (mode_tile "tend_day" 0) (mode_tile "head" 1) )) ) ; ; ; (defun ganhead () (setq ty (- ty 0.0625)) (setq ly (- ly 0.0625)) (setq tpt (list 8.5 ty)) (command "text") (command "r" tpt "0.375" "0" head) (command "setvar" "cmdecho" 1) (setq ty (- ty 0.375)) (setq ly (- ly 0.375)) (setq task1 nil) (setq h nil) ) ; ; ; ; (defun ganend () (print) (print) (setq task nil) (setq task1 nil) (setq h nil) (unload_dialog dcl_id) ) ; ; ; ; (defun twbar () (setq tans t) (print) (initget 7 "f o") (setq bartyp (getkword "Type of Bars (F)illed/(O)pen): ")) (if (= bartyp "f") (command "setvar" "fillmode" 1)) (if (= bartyp "o") (command "setvar" "fillmode" 0)) (setq dnam (getvar "dwgname")) (setq dnam (strcat dnam ".dat")) (setq f (open dnam "w")) (setq endmx 0) (setq ty 19.0) (setq ly 19.125) (while task (command "setvar" "cmdecho" 1) (setq task1 "t") (setq task "t") (setq h "t") (print) (setq tpt (list 8.5 ty)) (if (not (new_dialog "gantask" dcl_id)) (exit)) (set_tmonth_list) (set_day_list) (mode_tile "task" 2) (mode_tile "head" 1) (setq head nil) (setq tstart_month "0") (setq tstart_day "0") (setq tend_month "0") (setq tend_day "0") (action_tile "head_toggle" "(setq task (atoi $value)) (ganhead_on)") (action_tile "head" "(setq head $value)") (action_tile "task" "(setq task $value)") (action_tile "tstart_mon_list" "(setq tstart_month $value)") (action_tile "tstart_day" "(setq tstart_day $value)") (action_tile "tend_mon_list" "(setq tend_month $value)") (action_tile "tend_day" "(setq tend_day $value)") (action_tile "accept" "(setq tans 1) (done_dialog)") (action_tile "cancel" "(setq tans 0) (done_dialog)") (start_dialog) (if (or (= task " ") (= tans 0)) (ganend)) (if (/= head nil) (ganhead)) (while h (ptask) ) (while task1 (setq smon (itoa (+ (atoi tstart_month) 1))) (if (= smon "1") (setq endmx stmx1)) (if (= smon "2") (setq endmx stmx2)) (if (= smon "3") (setq endmx stmx3)) (if (= smon "4") (setq endmx stmx4)) (if (= smon "5") (setq endmx stmx5)) (if (= smon "6") (setq endmx stmx6)) (if (= smon "7") (setq endmx stmx7)) (if (= smon "8") (setq endmx stmx8)) (if (= smon "9") (setq endmx stmx9)) (if (= smon "10") (setq endmx stmx10)) (if (= smon "11") (setq endmx stmx11)) (if (= smon "12") (setq endmx stmx12)) (write-line smon f) (setq sday (+ (atoi tstart_day) 1)) (setq sdayt (rtos sday 2 2)) (write-line sdayt f) (setq sdayx (+ 8.75 (* sday incr) endmx)) (setq dayspt (list sdayx ly)) (setq endmx 0) (setq emon (itoa (+ (atoi tend_month) 1))) (if (= emon "1") (setq endmx stmx1)) (if (= emon "2") (setq endmx stmx2)) (if (= emon "3") (setq endmx stmx3)) (if (= emon "4") (setq endmx stmx4)) (if (= emon "5") (setq endmx stmx5)) (if (= emon "6") (setq endmx stmx6)) (if (= emon "7") (setq endmx stmx7)) (if (= emon "8") (setq endmx stmx8)) (if (= emon "9") (setq endmx stmx9)) (if (= emon "10") (setq endmx stmx10)) (if (= emon "11") (setq endmx stmx11)) (if (= emon "12") (setq endmx stmx12)) (write-line emon f) (setq eday (+ (atoi tend_day) 1)) (setq edayt (rtos eday 2 2)) (write-line edayt f) (setq edayx (+ 8.75 (* eday incr) endmx)) (setq dayept (list edayx ly)) (command "setvar" "cmdecho" 0) (command "trace") (command "0.25" dayspt dayept) (command "") (setq ty (- ty 0.375)) (setq ly (- ly 0.375)) (setq task1 nil) ) ) ) ; ; ; (defun set_tmonth_list () (setq month_list (list "Janvier" "Fevrier" "Mars" "Avril" "Mai" "Juin" "Juillet" "Aout" "Septembre" "Octobre" "Novembre" "Decembre")) (start_list "tstart_mon_list") (mapcar 'add_list month_list) (end_list) (start_list "tend_mon_list") (mapcar 'add_list month_list) (end_list) ) ; ; ; (defun set_day_list () (setq day_list (list "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15" "16" "17" "18" "19" "20" "21" "22" "23" "24" "25" "26" "27" "28" "29" "30" "31")) (start_list "tstart_day") (mapcar 'add_list day_list) (end_list) (start_list "tend_day") (mapcar 'add_list day_list) (end_list) ) ; ; ; (defun set_month_list () (setq month_list (list "Janvier" "Fevrier" "Mars" "Avril" "Mai" "Juin" "Juillet" "Aout" "Septembre" "Octobre" "Novembre" "Decembre")) (start_list "smonth_list") (mapcar 'add_list month_list) (end_list) (start_list "tstart_mon_list") (mapcar 'add_list month_list) (end_list) (start_list "tend_mon_list") (mapcar 'add_list month_list) (end_list) ) ; ; ; (defun set_smonth () (setq count smonth) (setq month_list2 month_list) (if (= count 0) (setq tb (car month_list2))) (while (> count 0) (setq month_list2 (cdr month_list2)) (setq smont (car month_list2)) (setq count (- count 1)) ) ) ; ; (defun set_tstart_month () (setq count tstart_month) (setq month_list3 month_list) (if (= count 0) (setq tb (car month_list3))) (while (> count 0) (setq month_list3 (cdr month_list3)) (setq t_start_mon (car month_list3)) (setq count (- count 1)) ) ) ; ; (defun set_tend_month () (setq count tend_month) (setq month_list4 month_list) (if (= count 0) (setq tb (car month_list4))) (while (> count 0) (setq month_list4 (cdr month_list4)) (setq t_end_mon (car month_list4)) (setq count (- count 1)) ) ) ; ; ; (defun C:GANTT () (command "setvar" "cmdecho" 0) (command "setvar" "blipmode" 0) (setq dcl_id (load_dialog "ddgantt.dcl")) (if (not (new_dialog "mongantt" dcl_id)) (exit)) (setq smon nil) (set_month_list) (setq smonth 0) (action_tile "smonth_list" "(setq smonth (atoi $value)) (set_smonth)") (action_tile "accept" "(setq ans 1) (done_dialog)") (action_tile "cancel" "(setq ans 0) (done_dialog)") (start_dialog) (if (and (= ans 1) (/= smont nil)) (progn (bordline) (gan1) (gan2) (twbar) (close f) ) ) (if (= ans 0) (unload_dialog dcl_id)) ) ; ; ; (princ "DDGANTT 2.0 © Greg MacGeorge, 2000....chargé.") (terpri) (princ "C:GANTT") (print) ; ; ************************************************************ // // DDGANTT.DCL Version 2.0 May 2000 // // DDGANTT.DCL - Used to get input for the DDGANTT.LSP program. dcl_settings : default_dcl_settings { audit_level = 0; } mongantt : dialog { label = "Gantt 2.0"; : column { :text {label = "Mois de départ:";} :popup_list { key = "smonth_list"; fixed_width; } } : row {ok_button; cancel_button;} } // // gantask : dialog { label = "Gantt Tâche"; :row { :column { label = "Header"; : toggle { label = "Header"; key = "head_toggle"; } } :column { label = "Header"; :edit_box { label = "Texte: "; key = "head"; fixed_width = true; } } } spacer_1; :row { label = "Tâche"; :edit_box { label = "Tâche: "; key = "task"; fixed_width = 15; } } spacer_1; :row { label = "Départ"; :column { :text {label = "Sélectionné le Mois de départ:";} :popup_list { key = "tstart_mon_list"; fixed_width; } } :column { :text {label = "Première Journée:";} :popup_list { key = "tstart_day"; fixed_width = true; } } } spacer_1; :row { label = "Fin"; :column { :text {label = "Dernier Mois:";} :popup_list { key = "tend_mon_list"; fixed_width; } } :column { :text {label = "Dernier Mois:";} :popup_list { key = "tend_day"; fixed_width = true; } } } spacer_1; : row {ok_button; cancel_button;} } // // :)

Voiçi celui que j'utilise. ;| WBL.lsp Bob Abernethy, dba/CADesigner ©1998 Create a wblocked dwg without keeping block in the original dwg Predefined insertion point set to 0,0,0 can be setup by removing comma on line below ;COMMENT2 and placing a comma in front of line below ;COMMENT1 Directory set to D:\BLDIR (@ COMMENT 0) - Directory MUST BE predefined change directory pointed to in line below COMMENT0 to point to the directory of your choice Wblock name given WILL overwrite if SAME filename is in directory |; ;COMMENT0 (setq bldir "D:\\bldir\\") (defun ERR (s) (if (/= s "Function cancelled \n\n") (if (= s "quit / exit abort") (princ) (alert " >> Error <<") ) ) (setvar "expert" XPRT) (command "undo" "back") (setq *error* olderr) (princ) ) (defun c:wbl (/ title) (setq dcl_id (load_dialog "wbl.dcl")) (if (not (new_dialog "wbl" dcl_id)) (exit) ) (action_tile "blkname" "(setq blkname $value)") (action_tile "accept" "(done_dialog 1)") (if (equal (start_dialog) 1) (do_wblock) ) (unload_dialog dcl_id) (princ) ) (defun do_wblock (/ bklname blkss blkpt) (setq olderr *error* *error* err ) (setq ce (getvar "cmdecho")) (setq osm (getvar "osmode")) (setvar "cmdecho" 0) (setq xprt (getvar "expert")) (setvar "expert" 2) (setvar "filedia" 0) (command "undo" "mark") (command "ucs" "w") (prompt "\nSelect entities to wblock") (setq blkss (ssget)) (setq blkpt (getpoint "\nPoint d'Insertion ... ")) ;COMMENT1 (command "_block" blkname blkpt blkss "") ;COMMENT2 ; (command "_block" blkname (list 0 0 0) blkss "") (command "oops") (command "_wblock" (strcat bldir blkname) blkname) (command "undo" "back") (setvar "filedia" 1) (setvar "expert" xprt) (setvar "osmode" osm) (setvar "cmdecho" ce) (setq *error* olderr) (princ) ) ***************************************************************** // WBL.DCL Dialogue Wblock , Bob Abernethy 1998 // Change D:\\BLDIR to your directory wbl : dialog { label = "Nom du Wblock "; initial_focus = "blkname"; : edit_box { edit_width = 20; key = "blkname"; label = "Nom du Wblock: "; allow_accept = true; is_default = true; } : paragraph { : text_part { label = " "; } : text_part { label = "Après avoir nommé le wblock, selectionné OK"; } : text_part { label = " "; } : text_part { label = "NOTE:"; } : text_part { label = "Wblock est placé dans D:\\BLDIR"; } } ok_cancel; } :)

Va à la rubrique chargement membre et il y a un RTEXT pour ce que tu veux. ;)

http://www.ploetzl.at/tools/autocad/fr_2_02.htm :)

Merçi à vous deux. Pour le fichier d'aide c'était déja fait. Pour ce qui est des fichier DCL je sais que c'est le lisp qui le charge dans Autocad. Ma question était, si l'on peut démarrer ObjetDCL directement à partir d'autocad. Je crois que non, il ne semble pas y avoir de lien direct entre AutoCad et le programme ObjetDCL. :)

Est-ce que l'un d'entre vous a réussi à installer objet dcl2004 correctement. J'ai téléchargé le Objetdcl full installation pour la 2004, décompressé le tout et chargé le objetdcl2004.arx dans le Startup suite et ai référence le chemin dans Autocad, mais aucun icône n'apparait dans Autocad. À partir du répertoire de ObjetDCL je peux ouvrir le fichier objetDcl MFC application ou créer un raccourci de ce fichier sur le bureau et l'ouvrir à partir de ce raccourci. Est-ce qu'il y a un lien directement à partir d'autocad ou si c'est la seul façon de procéder.

Bonjour Gile, Pour moi il serait intéressant que la prochaine version fonctionne sur Autocad 200 et 2004. Merçi d'avance

Merçi Bonuscad pour tes précisions. Comme je suis très débutant en lisp, quelles lignes de code je doit supprimer du lisp de Gile et entre quelles lignes j'insère ton code.

Cela ne fonctionne pas dasns l'espace papier; BAD ARGUMENT TYPE: LENTITYP NIL

Merçi Gile pour ton aide. Le programme est très consis, je vais étudié le code de plus près en fin de semaine. Cela fonctionne bien pour les degrés et on peut même changer l'orientation du texte, il faut au préalable spécifié A pour angle si non on l'erreur _U menu items group command: bad argument type = lentityp nil Pour ce qui est de l'option texte cela ne semble pas fonctionner; la ligne de cote en courbe est bien représentée, par contre je n'ai pas la cote automatiquement et/ou le texte inscrit à la ligne de commande, comme résultat j'ai plutôt l'inscription _U Alors peut-être que l'expert que tu es, connait déja la solution à ce problème. Je suis sur Autocad 2004. Salutations. François [Edité le 8/8/2006 par x13] [Edité le 8/8/2006 par x13]

Un gros Merçi de partager ton travail et tes connaissances, cela est grandement apprécié. François.

Comment faites vous pour coté la longueur d'un arc dans l'espace papier. J'ai bien quelques lisp qui le font dans l'espace objet dont en voiçi 3 . ;| ArcDim.Lsp & RepDim ArcDim - Creates New Dimensions with Arc Length, Chord, Angle, LC, LA, CA, or CLA of a selected arc. RepDim - Replaces Existing Dimensions with Arc Length, Chord, Angle, LC, LA, CA, or CLA of a selected arc. Version 2.4 - by Tippit CADD Services Parts of arclen and arccor code taken from arcinfo.lsp by Robert McNeel & Assoc. 1990 ------------------------------------------------------------------------ ------------------------------------------------------------------------ Created by J. Tippit, SPAUG President E-mail: cadpres@spaug.org Web Site: http://www.spaug.org Large donations to SPAUG is appreciated. :) ------------------------------------------------------------------------ ------------------------------------------------------------------------ 1.0 Created 08/11/98 1.1 Added support for missed and wrong entities 08/13/98-08/14/98 2.0 Added arccor & ArcDim 08/17/98 2.1 Revised RepDim similar to ArcDim 08/17/98 2.2 Added default values 09/10/98 2.3 Added UNITMODE check 09/14/98 2.4 Added LA, CA, and CLA options 05/15/00 |; (defun val (x ENT) (cdr (assoc x ENT))) (defun ENTTYP (ENT) (val 0 ENT)) (defun ENTNAM (ENT) (val -1 ENT)) (defun tan (x) (/ (sin x) (cos x))) (defun arclen (ENT / sa ea) (if (= "ARC" (val 0 ENT)) (progn (setq sa (val 50 ENT)) (setq ea (val 51 ENT)) (if (< ea sa) (setq ea (+ ea (* 2.0 pi))) ) (if(= 4 (getvar "aunits")) (setq a_i (angtos (- ea sa) 1)) (setq a_i (angtos (- ea sa))) ) (setq a_r (rtos (val 40 ENT))) (setq a_t (rtos (* (val 40 ENT) (tan (/ (- ea sa) 2.0))))) (setq a_l (rtos (* (- ea sa) (val 40 ENT)))) (* (- ea sa) (val 40 ENT)) ) ) ) (defun arccor () (setq sa (val 50 ent)) ;start angle (setq ea (val 51 ent)) ;end angle (if(= 4 (getvar "aunits")) (setq #ANGL (angtos (- ea sa) 1)) (setq #ANGL (angtos (- ea sa))) ) (setq ctr (cdr (assoc 10 ent))) (setq r (cdr (assoc 40 ent))) (setq s1 (cdr (assoc 50 ent))) (setq s2 (cdr (assoc 51 ent))) (setq PT1 (polar ctr s1 r)) (setq PT2 (polar ctr s2 r)) (setq #CHOR (rtos (distance PT1 PT2))) ;chord length ) (defun c:RepDim (/ OBJ OBJ2) (setvar "cmdecho" 0) (command "undo" "be") (if (= (getvar "unitmode") 1)(setvar "unitmode" 0)) (command "ucs" "") (initget "C L A CA LC LA CLA") (setq CORL (getkword "\nhord, ength, ngle, CA, LC, LA, or CLA? : ")) (if (not CORL)(setq CORL "C")) (while (not OBJ) (progn (setq OBJ (entsel "\nSélectionnez un Arc: ")) (if OBJ (progn (setq ENT (entget (car OBJ))) (if (= (cdr (assoc 0 ENT)) "ARC") (setq #arclen (rtos (arclen ENT))) (progn (setq OBJ nil) (prompt "\nL'objet sélectionné n'est pas un arc. réessayé. ") ) ) ) (princ "\nArc manquant. Essayez à nouveau...") ) ) ) (arccor) (while (not OBJ2) (progn (setq OBJ2 (entsel "\nSélectinnez Dimension: ")) (if OBJ2 (progn (setq ENT2 (entget (car OBJ2))) (if (= (cdr (assoc 0 ENT2)) "DIMENSION") (progn (setq ENT3 (entget (car OBJ2)) txt_old (cdr (assoc 1 ENT3))) (cond ((= CORL "C")(entmod (subst (cons 1 (strcat "CH=" #CHOR)) (assoc 1 ENT3) ENT3))) ((= CORL "L")(entmod (subst (cons 1 (strcat "L=" #arclen)) (assoc 1 ENT3) ENT3))) ((= CORL "A")(entmod (subst (cons 1 (strcat "CH=" #CHOR)) (assoc 1 ENT3) ENT3))) ((= CORL "LC")(entmod (subst (cons 1 (strcat "L=" #ARCLEN "\\XCH=" #CHOR)) (assoc 1 ENT3) ENT3))) ((= CORL "CA")(entmod (subst (cons 1 (strcat "CH=" #CHOR "\\XA=" #ANGL)) (assoc 1 ENT3) ENT3))) ((= CORL "LA")(entmod (subst (cons 1 (strcat "L=" #ARCLEN "\\XA=" #ANGL)) (assoc 1 ENT3) ENT3))) ((= CORL "CLA")(entmod (subst (cons 1 (strcat "CH=" #CHOR " L=" #ARCLEN "\\XA=" #ANGL)) (assoc 1 ENT3) ENT3))) ) ) (progn (setq OBJ2 nil) (prompt "\nSelected object is not a DIMENSION. Try again. ") ) ) ) (princ "\nMissed the DIMENSION. Try again...") ) ) ) (command "ucs" "P") (command "undo" "e") (setvar "cmdecho" 1) (princ) ) (defun c:ArcDim (/ OBJ ENT #ARCLEN PT1 PT2) (setvar "cmdecho" 0) (command "undo" "be") (if (= (getvar "unitmode") 1)(setvar "unitmode" 0)) (command "ucs" "") (initget "A H V") (setq AHV (getkword "\nligned, orizontal, or ertical? : ")) (if (not AHV)(setq AHV "H")) (initget "C L A LC LA CLA") (setq CORL (getkword "\nhord, ength, ngle, CA, LC, LA, or CLA? : ")) (if (not CORL)(setq CORL "C")) (while (not OBJ) (progn (setq OBJ (entsel "\nSelect Arc: ")) (if OBJ (progn (setq ENT (entget (car OBJ))) (if (= (cdr (assoc 0 ENT)) "ARC") (setq #ARCLEN (rtos (arclen ENT))) (progn (setq OBJ nil) (prompt "\nSelected object is not an ARC. Try again. ") ) ) ) (princ "\nMissed the Arc. Try again...") ) ) ) (arccor) (cond ((= AHV "A")(DALI)) ((= AHV "H")(DHOR)) ((= AHV "V")(DVER)) ) (command "ucs" "P") (command "undo" "e") (setvar "cmdecho" 1) (princ) ) (defun DALI () (cond ((= CORL "C")(command "dim1" "ali" PT1 PT2 pause (strcat "CH=" #CHOR))) ((= CORL "L")(command "dim1" "ali" PT1 PT2 pause (strcat "L=" #ARCLEN))) ((= CORL "A")(command "dim1" "ali" PT1 PT2 pause (strcat "A=" #ANGL))) ((= CORL "LC")(command "dim1" "ali" PT1 PT2 pause (strcat "L=" #ARCLEN "\\XCH=" #CHOR))) ((= CORL "CA")(command "dim1" "ali" PT1 PT2 pause (strcat "CH=" #CHOR "\\XA=" #ANGL))) ((= CORL "LA")(command "dim1" "ali" PT1 PT2 pause (strcat "L=" #ARCLEN "\\XA=" #ANGL))) ((= CORL "CLA")(command "dim1" "ali" PT1 PT2 pause (strcat "CH=" #CHOR " L=" #ARCLEN "\\XA=" #ANGL))) ) ) (defun DHOR () (cond ((= CORL "C")(command "dim1" "hor" PT1 PT2 pause (strcat "CH=" #CHOR))) ((= CORL "L")(command "dim1" "hor" PT1 PT2 pause (strcat "L=" #ARCLEN))) ((= CORL "A")(command "dim1" "hor" PT1 PT2 pause (strcat "A=" #ANGL))) ((= CORL "LC")(command "dim1" "hor" PT1 PT2 pause (strcat "L=" #ARCLEN "\\XCH=" #CHOR))) ((= CORL "CA")(command "dim1" "hor" PT1 PT2 pause (strcat "CH=" #CHOR "\\XA=" #ANGL))) ((= CORL "LA")(command "dim1" "hor" PT1 PT2 pause (strcat "L=" #ARCLEN "\\XA=" #ANGL))) ((= CORL "CLA")(command "dim1" "hor" PT1 PT2 pause (strcat "CH=" #CHOR " L=" #ARCLEN "\\XA=" #ANGL))) ) ) (defun DVER () (cond ((= CORL "C")(command "dim1" "ver" PT1 PT2 pause (strcat "CH=" #CHOR))) ((= CORL "L")(command "dim1" "ver" PT1 PT2 pause (strcat "L=" #ARCLEN))) ((= CORL "A")(command "dim1" "ver" PT1 PT2 pause (strcat "A=" #ANGL))) ((= CORL "LC")(command "dim1" "ver" PT1 PT2 pause (strcat "L=" #ARCLEN "\\XCH=" #CHOR))) ((= CORL "CA")(command "dim1" "ver" PT1 PT2 pause (strcat "CH=" #CHOR "\\XA=" #ANGL))) ((= CORL "LA")(command "dim1" "ver" PT1 PT2 pause (strcat "L=" #ARCLEN "\\XA=" #ANGL))) ((= CORL "CLA")(command "dim1" "ver" PT1 PT2 pause (strcat "CH=" #CHOR " L=" #ARCLEN "\\XA=" #ANGL))) ) ) (prompt "\nCopyright \251 TCS 1998-2000. Arc Dimensioning Routine Ver 2.4 loaded.\nUse ARCDIM to Create a New Dimension\n or REPDIM to Replace an Existing Dimension.") (princ) *********************************************************************** ;;;CADALYST 09/04 Tip1977: DIMARC.LSP Dimension an Arc © 2004 Leonid Nemirovsky (vl-load-com) (defun c:dimarc (/ cm arcel obj num lu txt) (setq cm (getvar "cmdecho")) (setvar"cmdecho" 0) (setq arcel (entsel "\nSélectionnez un Arc: ")) (while (if (/= (cdr(assoc 0 (entget(car arcel)))) "ARC") (progn (prompt "\nSelected Object is not an ARC") (setq arcel (entsel "\nSelect Arc: ")) ) ) ) (setq obj (vlax-ename->vla-object (car arcel))) (setq num (vla-get-ArcLength obj)) (setq lu (getvar "lunits")) (cond ((= lu 1)(setq txt (rtos num 1))) ((= lu 2)(setq txt (rtos num 2))) ((= lu 3)(setq txt (rtos num 3))) ((= lu 4)(setq txt (rtos num 4))) ((= lu 5)(setq txt (rtos num 5))) ) (command "dimangular" arcel "t" txt pause) (setvar "cmdecho" cm) (princ) ) ******************************************************************** (DEFUN c:dimarc1 (/ |ang1| |ang2| |ang| |arclen| |arcx| |arc| |cen| |cmdecho| |ent| |ept1| |ept| |olderror| |orthomode| |polarmode| |pt1| |pt2| |rad| |type| ) (COMMAND "undo" "begin") (SETQ |cmdecho| (GETVAR "cmdecho")) (SETQ |orthomode| (GETVAR "orthomode")) (SETQ |polarmode| (GETVAR "polarmode")) (SETVAR "cmdecho" 0) (SETVAR "orthomode" 0) (SETQ |arc| (ENTSEL "\nSpecify arc: ")) (SETQ |arcx| (CAR |arc|)) (SETQ |ent| (ENTGET |arcx|)) (SETQ |type| (CDR (ASSOC 0 |ent|))) (IF (= |type| "ARC") (PROGN (SETQ |pt1| (CDR (ASSOC 50 |ent|))) (SETQ |pt2| (CDR (ASSOC 51 |ent|))) (SETQ |cen| (CDR (ASSOC 10 |ent|)) |rad| (CDR (ASSOC 40 |ent|)) ) (SETQ |ept| (POLAR |cen| (CDR (ASSOC 50 |ent|)) |rad|) |ept1| (POLAR |cen| (CDR (ASSOC 51 |ent|)) |rad|) ) (IF (< |pt1| |pt2|) (SETQ |ang| (- |pt1| |pt2|) |arclen| (ABS (* |rad| |ang|)) ) (SETQ |ang1| (ANGLE |ept| |cen|) |ang2| (ANGLE |ept1| |cen|) |ang| (- |ang1| |ang2|) |arclen| (ABS (* |rad| |ang|)) ) ) (PROMPT "\nSpecify dimension line location: ") (COMMAND "dim" "angular" "" |cen| |ept| |ept1| pause (RTOS |arclen|) "" "exit" ) ) (PROMPT "\nThe selected entity was not an arc: ") ) (SETVAR "cmdecho" |cmdecho|) (SETVAR "orthomode" |orthomode|) (SETVAR "polarmode" |polarmode|) (COMMAND "undo" "end") (PRINC) ) ********************************************************************** Merçi de votre aide. [Edité le 8/8/2006 par x13]