I have a error message with this lisp. The first lie of text is ok, but the underline of text dont work.
I put undercore before command for use with french version.
I use Autocad 2000 and 2004, work in metric with decimal units.
Where is the problem.
Thank for your help.
François.
;Tip1789: TITLE.LSP DETAIL TITLE (c)2002, Roy Everitt
;;; Title.lsp
;;;
;;; Permission to use, copy, modify, and distribute this software and its
;;; documentation for any purpose and without fee is hereby granted.
;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY.
;;; ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF
;;; MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;;; Copyright© Roy Everitt
;;; March, 2000
;;;
;;; Note: Older versions of Autocad will not recognize the *error* function. You will
;;; need to replace the (defun-q *error* (msg) statement with (defun *error* (msg).
;;;
;;; Place a "DETAIL" title callout in the drawing on the designated layer "CALLOUT"
;;; for drawing callouts... may be modified to user preference. The program uses a
;;; combination of drawing environment settings for (dimscale & dimtxt) to determine
;;; the appropriate text sizes to use. The program places an underline below the
;;; title. It also has the option for a reference Balloon Callout at the left.
;;; Pre-defined Title and Subtitle lists can also be modified for user preferences.
;;;
;;; The program also generates a custom DCL file (temp.dcl) that is re-written each
;;; time it is executed. The code may be changed so that temp.dcl is written to, and
;;; found in any user preferred folder, as long as that folder is in the Support Files
;;; Search Path.
;;; Note: By default, it will be written in your Autocad Working Directory, (wherever
;;; your shortcut or "Start In" Icon is set up to work).
;;; Example: Look for the code: (setq fd (open "temp.dcl" "w"))
;;; Change it to: (setq fd (open "c:\\myfolder\\temp.dcl" "w"))
;;; Look for the code: (close (open "temp.dcl" "w") )
;;; Change it to: (close (open "c:\\myfolder\\temp.dcl" "w") )
;;; Look for the code: (if (< (setq *titleid* (load_dialog "temp.dcl")) 0)
;;; Change it to: (if (< (setq *titleid* (load_dialog "c:\\myfolder\\temp.dcl")) 0)
;;; (Where "myfolder" is your designated folder name)
;;;=================================================================================
(princ "\Title Maker Program loading...")
(defun
C:TITLE (/ TITLE_STYLE TITLE_FONT TITLE_LAYER TITLE_COLOR TITLE_LAYER
OL OS OC CR DLG_CLOSE FD SYMTOS DLG_HEADER DLG_MAIN
DLG_DIALOG DLG_ITEM DLG_ATT DLG_PROTO DCL_TEMP TITLE
SUBTITLE NUMBR *TITLEID* TEST GET_INPUT FLAG
)
;;;;;main dialog control functions;;;;
(defun CR () (princ "\n" FD))
(defun DLG_CLOSE () (princ "}" FD) (CR))
(defun
DLG_HEADER (AUDIT)
(princ "dcl_settings : default_dcl_settings {" FD)
(CR)
(princ (strcat " audit_level = " (itoa AUDIT) "; }") FD)
(CR)
) ;_ end of defun
(defun DLG_DIALOG (NAME) (princ (strcat NAME " : dialog {") FD) (CR))
(defun DLG_ITEM (ITEM) (princ (strcat ": " ITEM "{") FD) (CR))
(defun DLG_PROTO (type) (princ (strcat type ";") FD) (CR))
(defun
DLG_ATT (ATT VAL)
(cond
((= (type VAL) 'INT)
(princ (strcat ATT "=" (itoa VAL) ";") FD)
(CR)
)
((= (type VAL) 'REAL)
(princ (strcat ATT "=" (rtos VAL) ";") FD)
(CR)
)
((= (type VAL) 'STR)
(princ (strcat ATT "=\"" VAL "\";") FD)
(CR)
)
((= (type VAL) 'SYM)
(princ (strcat ATT "=" (SYMTOS VAL) ";") FD)
(CR)
)
) ;_ end of cond
) ;_ end of defun
(defun
SYMTOS (SYM / FD)
(setq FD (open "symtos.txt" "w"))
(princ SYM FD)
(close FD)
(setq
FD (open "symtos.txt" "r")
SYM (strcase (read-line FD) t)
) ;_ end of setq
(close FD)
SYM
) ;_ end of defun
(defun
DCL_TEMP (/ FD)
(setq FD (open "J:\\ESTB\\temp.dcl" "w")) ;;;Ligne à modifier si requis
(DLG_HEADER 0)
;;;define main dialog;;;
(DLG_DIALOG "dlg_main")
(DLG_ATT "label" "Programme-Titre de détail....par Roy Everitt")
(DLG_ITEM "row")
(DLG_ITEM "boxed_row")
(DLG_ATT "label" "Nombre:")
(DLG_ITEM "edit_box")
(DLG_ATT "alignment" 'LEFT)
(DLG_ATT "fixed_width" 'TRUE)
(DLG_ATT "key" "numbr")
(DLG_ATT "edit_width" 4)
(DLG_ATT "edit_limit" 4)
(DLG_CLOSE)
(DLG_CLOSE)
(DLG_ITEM "column")
(DLG_ITEM "edit_box")
(DLG_ATT "key" "title")
(DLG_ATT "label" "TITRE:")
(DLG_ATT "edit_width" 30)
(DLG_CLOSE)
(DLG_ITEM "popup_list")
(DLG_ATT "label" "Prédéfini:")
(DLG_ATT "key" "title_def")
(DLG_ATT "edit_width" 30)
(DLG_CLOSE)
(DLG_ITEM "edit_box")
(DLG_ATT "label" "SOUS-TITRE:")
(DLG_ATT "key" "subtitle")
(DLG_ATT "edit_width" 30)
(DLG_CLOSE)
(DLG_ITEM "popup_list")
(DLG_ATT "label" "Prédéfini:")
(DLG_ATT "key" "sub_def")
(DLG_ATT "edit_width" 30)
(DLG_CLOSE)
(DLG_CLOSE)
(DLG_CLOSE)
(DLG_PROTO "spacer_1")
(DLG_ITEM "button")
(DLG_ATT "key" "loc")
(DLG_ATT "label" "Localiser l'emplacement du Titre sur le dessin")
(DLG_ATT "fixed_width" 'TRUE)
(DLG_ATT "height" 2)
(DLG_ATT "alignment" 'CENTERED)
(DLG_CLOSE)
(DLG_PROTO "cancel_button")
(DLG_CLOSE)
(close FD)
"temp.dcl"
) ;_ end of defun
(defun
LOAD_TITLE (VALUE)
(setq NEW_VALUE (atoi VALUE))
(set_tile "title" (nth NEW_VALUE TITLE-LIST))
(setq TITLE (nth NEW_VALUE TITLE-LIST))
) ;_ end of defun
(defun
LOAD_SUB (VALUE)
(setq NEW_VALUE (atoi VALUE))
(set_tile "subtitle" (nth NEW_VALUE SUB-LIST))
(setq SUBTITLE (nth NEW_VALUE SUB-LIST))
) ;_ end of defun
(defun
DRAW_TITLE (/ N W S E DS OSM OCC PT1 SIZE TITLE_TXT TB LL UR
TITLE_LGTH PT2 SUBT_TXT SUBT_LGTH RAD PT3 PT4 PT5 TEST
)
(command "_style" "romans" "romans.shx" "" "" "" "" "" "")
(setq
N (* 0.5 pi)
W pi
S (* 1.5 pi)
E 0
) ;_ end of setq
(setq
OL (getvar "clayer")
OS (getvar "textstyle")
OC (getvar "cmdecho")
DS (getvar "dimscale")
OSM (getvar "osmode")
OCC (getvar "cecolor")
) ;_ end of setq
(setvar "cmdecho" 0)
(setq PT1 (getpoint "\nDéterminé le point central du TITRE: "))
(setvar "osmode" 0)
(setq SIZE (* 1.5 (getvar "dimscale") (getvar "dimtxt")))
(if (= (tblsearch "layer" "CALLOUT") NIL)
(command
"_layer" "_make" "CALLOUT" "_color" "_red" "" "_set" "CALLOUT" ""
) ;_ end of command
;_ end of command
) ;_ end of if
(setvar "clayer" "CALLOUT")
(command "_text" "j" "c" PT1 SIZE "0" TITLE)
(setq
TITLE_TXT
(entget (entlast))
TB (textbox TITLE_TXT)
LL (car TB)
UR (cadr TB)
TITLE_LGTH
(+ (/ (distance LL UR) 2) (/ SIZE 2))
) ;_ end of setq
(setq PT2 (polar PT1 S (/ SIZE 2)))
(command
"_text"
"j"
"tc"
(polar PT2 S (/ SIZE 2))
(* 0.666 SIZE)
"0"
SUBTITLE
) ;_ end of command
(setq
SUBT_TXT
(entget (entlast))
TB (textbox SUBT_TXT)
LL (car TB)
UR (cadr TB)
SUBT_LGTH
(+ (/ (distance LL UR) 2) (/ SIZE 2))
) ;_ end of setq
(if (< SUBT_LGTH TITLE_LGTH)
(setq LGTH TITLE_LGTH)
(setq LGTH SUBT_LGTH)
) ;_ end of if
(setq
RAD (* 0.3333 DS)
PT3 (polar PT2 E LGTH)
PT4 (polar PT2 W LGTH)
PT5 (polar PT4 W RAD)
) ;_ end of setq
(command "_line" PT3 PT4 "")
(if (/= NUMBR NIL)
(progn
(command "_circle" PT5 RAD)
(command "_text" "j" "m" PT5 (* 0.15 DS) "0" NUMBR)
) ;_ end of progn
) ;_ end of if
(setvar "dimscale" DS)
(setvar "cecolor" OCC)
(setvar "osmode" OSM)
(setvar "clayer" OL)
(setvar "cmdecho" 1)
(princ)
) ;_ end of defun
(defun
GET_INPUT ()
(if (< (strlen (setq TITLE (get_tile "title"))) 1)
(progn
(setq FLAG t)
(alert
"\nAucune identification de TITRE n'est présente...\nSVP inscrire un TITRE!\n\n"
) ;_ end of alert
(mode_tile "title" 2)
) ;_ end of progn
(setq TEST "ok")
) ;_ end of if
(if FLAG
NIL
t
) ;_ end of if
) ;_ end of defun
(defun
DLG_MAIN (/ XIT)
(close (open "J:\\ESTB\\temp.dcl" "w")) ;;;Ligne à modifier si requis
(if (not (new_dialog "dlg_main" *TITLEID*))
(exit)
) ;_ end of if
(TILES_DLG_TITLE)
(ACTIONS_DLG_TITLE)
(setq XIT (start_dialog))
;;; Dialog Removed
;;; xit = Value passed from done_dialog
;;; (defined in actions_dlg_title)
(setq FD (open "symtos.txt" "w"))
(princ "" FD)
(close FD)
(princ)
) ;_ end of defun
(defun TILES_DLG_TITLE () (mode_tile "title" 2))
(defun
ACTIONS_DLG_TITLE (/ FLAG)
(action_tile "title" "(setq title $value)")
(action_tile "subtitle" "(setq subtitle $value)")
(action_tile "numbr" "(setq numbr $value)")
(setq
TITLE-LIST
'("" "COUPE" "COUPE-A" "COUPE A-A" "COUPE-B" "COUPE B-B" "COUPE-C" "COUPE C-C"
"COUPE-D" "COUPE D-D" "COUPE DE MUR" "COUPE DE MUR-TYPE" "COUPE TRANSVERSALE"
"COUPE TRANSVERSALE A-A" "COUPE TRANSVERSALE B-B" "COUPE LONGITUDINALE"
"COUPE LONGITUDINALE A-A" "COUPE LONGITUDINALE B-B" "DÉTAIL TYPE" "ÉLÉVATION TYPE"
"ÉLÉVATION AXE -A-" "VUE EN PLAN" "VUE EN ÉLÉVATION" "VUE ISOMÉTRIQUE"
)
) ;_ end of setq
(start_list "title_def")
(mapcar 'add_list TITLE-LIST)
(end_list)
(action_tile "title_def" "(load_title $value)")
(setq
SUB-LIST
'(" " "ECHELLE: AUCUNE" "ECHELLE: PLEINE GRANDEUR 1=1" "ECHELLE: DEMI-GRANDEUR 1/2"
"ECHELLE: 3\"=1'-0\"" "ECHELLE: 1-1/2\"=1'-0\"" "ECHELLE: 1\"=1'-0\""
"ECHELLE: 3/4\"=1'-0\"" "ECHELLE: 1/2\"=1'-0\"" "ECHELLE: 3/8\"=1'-0\""
"ECHELLE: 1/4\"=1'-0\"" "ECHELLE: 1/8\"=1'-0\"" "ECHELLE: 1/16\"=1'-0\""
"ECHELLE: 1=5" "ÉCHELLE: 1=10" "ÉCHELLE: 1=20" "ÉCHELLE:1=25" "ÉCHELLE: 1=50"
" ÉCHELLE: 1=75" "ÉCHELLE: 1=100" "ÉCHELLE: 1=200" "ÉCHELLE: 1=250" "ÉHELLE: 1=500"
)
) ;_ end of setq
(start_list "sub_def")
(mapcar 'add_list SUB-LIST)
(end_list)
(action_tile "sub_def" "(load_sub $value)")
(action_tile "loc" "(if (setq flag (get_input))(done_dialog 1) )")
;;; 'Cancel' button
(action_tile "cancel" "(setq test nil)(done_dialog 0)")
) ;_ end of defun
;;; define error routine ;;;
(setq TITLE_ERR *ERROR*)
(defun-q
*ERROR*
(MSG)
(princ MSG)
(setq *ERROR* TITLE_ERR)
(if OL
(setvar "clayer" OL)
) ;_ end of if
(if OS
(setvar "textstyle" OS)
) ;_ end of if
(if OC
(setvar "cmdecho" OC)
) ;_ end of if
(if OCC
(setvar "cecolor" OCC)
) ;_ end of if
(if OSM
(setvar "osmode" OSM)
) ;_ end of if
(if DS
(setvar "dimscale" DS)
) ;_ end of if
(setq FD (open "symtos.txt" "w"))
(princ "" FD)
(close FD)
(princ)
) ;_ end of defun-q
;;; perform creation of dialog, load dialog & set global handle (*titleid*) ;;;
(if (not *TITLEID*)
;;; first time thru
(progn
(DCL_TEMP)
(if (< (setq *TITLEID* (load_dialog "J:\\ESTB\\temp.dcl")) 0) ;;;Ligne à modifier si requis
(*ERROR* "dialog load error")
) ;_ end of if
) ;_ end of progn
) ;_ end of if
(DLG_MAIN)
(if (= TEST "ok")
(DRAW_TITLE)
) ;_ end of if
;;; restore error handler and exit ;;;
(terpri)
(*ERROR* "Title Maker Program finished...")
) ;_ end of defun
(princ "loaded")
(princ)
(terpri)
(princ "\n->defined command...title")
(princ)
