Lisp Error
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi There I have another problem with this lisp. The DCL won't load up can anyone help. Lisp and DCL below.
Lisp
;;;----------------------------------------------------------------------
;;; COPYRIGHT (C) 1995-2000 by Watt-Smith Partners & Associates pty ltd
;;;
;;;
;;; 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.
;;;
;;;----------------------------------------------------------------------
;;;Last Update: 07.11.2000
;;;----------------------------------------------------------------------
;(princ "\nInitial load, please wait...")
;;;*** Function DDCHTEXT_ATTACHMENT
;;;This function processes the callback from the mtext attachment list box
(defun DDCHTEXT_ATTACHMENT (value)
(setq chtx_proc_at T)
(setq chtx_apoi (nth (atoi value) chtx_apoi_list))
)
;;;*** Function DDCHTEXT_CHECK
;;;This function runs a check on the dialog selections and reports any
;;;errors to "error"
(defun DDCHTEXT_CHECK (/)
(setq chtx_stop nil) ;clear
;;;check for height input
(if chtx_proc_h
(if (not (> (atof chtx_heig) 0))
(progn
(alert
(strcat "Height must be a real number,"
"\nAnd greater than 0."
)
)
(setq chtx_stop T)
)
)
)
;;;check for width input
(if chtx_proc_w
(if (not (> (atof chtx_widt) 0))
(progn
(alert
(strcat "The Width Factor must be a real number,"
"\nAnd greater than 0."
)
)
(setq chtx_stop T)
)
)
)
;;;close dialog and perform changes...
(if (not chtx_stop)
(progn
(setq chtx_go T)
(done_dialog)
)
)
)
;;;
;;;*** Function DDCHTEXT_DIALOG
;;;Runs the dialog
(defun DDCHTEXT_DIALOG (/)
;;;check for the wpa_ddch.dcl and run program if found...
(if (findfile "wpa_ddch.dcl")
(progn
(setq what_next 10)
(while (< 2 what_next)
(setq dcl_id (load_dialog "wpa_ddch")) ;load the dialog
(new_dialog "wpa_ddch" dcl_id) ;open the dialog box
(DDCHTEXT_INITIAL) ;Set the dialog settings
(logo)
;;;***CALLBACKS
;;;if Height is entered...
(action_tile "height" "(ddchtext_height $value)")
;;;if Rotation is entered...
(action_tile "rotation" "(setq chtx_rota $value)")
;;;if Width is entered
(action_tile "width_factor" "(ddchtext_width $value)")
;;;if Obliquing angle is entered
(action_tile "obliquing" "(setq chtx_obli $value)")
;;;if Justification is picked...
(action_tile "justification" "(ddchtext_just $value)")
;;;if Attachment is picked...
(action_tile "attachment" "(ddchtext_attachment $value)")
;;;if Direction is picked...
(action_tile "direction" "(ddchtext_direction $value)")
;;;if Text Style is picked...
(action_tile
"styles"
"(setq chtx_styl (nth (atoi $value) chtx_styl_list))"
)
;;;if Text button is picked...
(action_tile "text_button" "(ddchtext_text)")
;;;if < Pick buttons are selected...
(action_tile "height_pick" "(done_dialog 4)")
(action_tile "rotation_pick" "(done_dialog 5)")
(action_tile "width_pick" "(done_dialog 6)")
(action_tile "obliquing_pick" "(done_dialog 7)")
;;;if OK button is pressed...
(action_tile "accept" "(ddchtext_check)")
;;;if Help button is pressed, show help...
(action_tile
"help"
"(acad_helpdlg \"acad.hlp\" \"wpa_chgt\")"
)
;;;point to your own help here...
(setq what_next (start_dialog))
;;;start the dialog...
(cond
;;;if < Pick button was selected...
((= what_next 4)
(setq chtx_flag (getdist "\nText height: "))
(if chtx_flag
(setq chtx_heig (rtos chtx_flag))
(alert "No text height was entered...")
)
)
((= what_next 5)
(setq chtx_flag (getangle "\nText rotation: "))
(if chtx_flag
(setq chtx_rota (angtos chtx_flag))
(alert "No rotation angle was entered...")
)
)
((= what_next 6)
(setq chtx_flag (getdist "\nText width: "))
(if chtx_flag
(setq chtx_widt (rtos chtx_flag))
(alert "No text width was selected...")
)
)
((= what_next 7)
(setq chtx_flag (getangle "\nObliquing angle: "))
(if chtx_flag
(setq chtx_obli (angtos chtx_flag))
(alert "No obliquing angle was entered...")
)
)
) ;end of cond
) ;end of while
) ;end of progn
(alert "Unable to find DDCHTEXT.dcl")
)
;;;end of if
)
;;;*** Function DDCHTEXT_DIRECTION
;;;This function processes the callback from the mtext direction list box
(defun DDCHTEXT_DIRECTION (value)
(setq chtx_proc_dir T)
(setq chtx_dpoi (nth (atoi value) chtx_dpoi_list))
)
;;;*** Function DDCHTEXT_GETINFO
;;;Gets all information about select text or mtext for mapping into tiles
(defun DDCHTEXT_GETINFO (/) ;;; CAN'T BRING UP DCL FILE
;;;Set empty lists
(setq chtx_hlis '()) ;text height
(setq chtx_rlis '()) ;text rotation
(setq chtx_wlis '()) ;text width
(setq chtx_olis '()) ;obliquing angle
(setq chtx_jlis '()) ;text justification
(setq chtx_alis '()) ;mtext attachment
(setq chtx_dlis '()) ;mtext direction
(setq chtx_slis '()) ;style
(setq chtx_indx 0)
;;;set selection set for processing
(if (eq chtx_objt "Text")
(setq sst1_proc sst1_text)
(setq sst1_proc sst1_mtxt)
)
;;;process selection set
(repeat (sslength sst1_proc)
;;;get heights
(setq chtx_hlis
(cons (cdr (assoc '40 (entget (ssname sst1_proc chtx_indx))))
chtx_hlis
)
)
;;;get rotations
(if (eq chtx_objt "Text")
(setq chtx_rlis
(cons (rtod
(cdr (assoc '50 (entget (ssname sst1_proc chtx_indx))))
)
chtx_rlis
)
)
)
;;;get widths
(setq chtx_wlis
(cons (cdr (assoc '41 (entget (ssname sst1_proc chtx_indx))))
chtx_wlis
)
)
;;;get obliquing angles
(if (eq chtx_objt "Text")
(setq chtx_olis
(cons (rtod
(cdr (assoc '51 (entget (ssname sst1_proc chtx_indx))))
)
chtx_olis
)
)
)
;;;get attachment point
(if (eq chtx_objt "Mtext")
(setq chtx_ajus
(cdr (assoc '71 (entget (ssname sst1_proc chtx_indx)))
)
)
)
;;;get justification/direction code 72
(setq chtx_hjus
(cdr (assoc '72 (entget (ssname sst1_proc chtx_indx))))
)
;;;get justification code 73
(if (eq chtx_objt "Text")
(setq chtx_vjus
(cdr (assoc '73 (entget (ssname sst1_proc chtx_indx)))
)
)
)
(if (eq chtx_objt "Text")
(setq chtx_jlis
(cons
(cond
((and (eq chtx_hjus 0) (eq chtx_vjus 0)) "Left")
((and (eq chtx_hjus 0) (eq chtx_vjus 1)) "BLeft")
((and (eq chtx_hjus 0) (eq chtx_vjus 2)) "MLeft")
((and (eq chtx_hjus 0) (eq chtx_vjus 3)) "TLeft")
((and (eq chtx_hjus 1) (eq chtx_vjus 0)) "Center")
((and (eq chtx_hjus 1) (eq chtx_vjus 1)) "BCenter")
((and (eq chtx_hjus 1) (eq chtx_vjus 2)) "MCenter")
((and (eq chtx_hjus 1) (eq chtx_vjus 3)) "TCenter")
((and (eq chtx_hjus 2) (eq chtx_vjus 0)) "Right")
((and (eq chtx_hjus 2) (eq chtx_vjus 1)) "BRight")
((and (eq chtx_hjus 2) (eq chtx_vjus 2)) "MRight")
((and (eq chtx_hjus 2) (eq chtx_vjus 3)) "TRight")
((and (eq chtx_hjus 3) (eq chtx_vjus 0)) "Align")
((and (eq chtx_hjus 4) (eq chtx_vjus 0)) "Middle")
((and (eq chtx_hjus 5) (eq chtx_vjus 0)) "Fit")
)
chtx_jlis
)
)
(setq chtx_dlis
(cons
(cond
((eq chtx_hjus 1) "Left to Right")
((eq chtx_hjus 2) "Right to Left")
((eq chtx_hjus 3) "Top to Bottom")
((eq chtx_hjus 4) "Bottom to Top")
)
chtx_dlis
)
)
)
(if (eq chtx_objt "Mtext")
(setq chtx_alis
(cons
(cond
((eq chtx_ajus 1) "TopLeft")
((eq chtx_ajus 2) "TopCenter")
((eq chtx_ajus 3) "TopRight")
((eq chtx_ajus 4) "MiddleLeft")
((eq chtx_ajus 5) "MiddleCenter")
((eq chtx_ajus 6) "MiddleRight")
((eq chtx_ajus 7) "BottomLeft")
((eq chtx_ajus 😎 "BottomCenter")
((eq chtx_ajus 9) "BottomRight")
)
chtx_alis
)
)
)
(setq chtx_slis
;;;get styles
(cons
(cdr (assoc '7 (entget (ssname sst1_proc chtx_indx))))
chtx_slis
)
)
;;;step up index
(setq chtx_indx (1+ chtx_indx))
)
)
;;;*** Function DDCHTEXT_GETTEXT
;;;Filters out text from selected objects...
(defun DDCHTEXT_GETTEXT (/)
;;;create empty selection sets for each text object
(setq sst1_text (ssadd)) ;text
(setq sst1_mtxt (ssadd)) ;mtext
;;;for each selected object...
(setq indx 0)
(repeat (sslength chtx_sst1)
(if (eq (cdr (assoc '0 (entget (ssname chtx_sst1 indx))))
"TEXT"
)
(ssadd (ssname chtx_sst1 indx) sst1_text)
)
(if (eq (cdr (assoc '0 (entget (ssname chtx_sst1 indx))))
"MTEXT"
)
(ssadd (ssname chtx_sst1 indx) sst1_mtxt)
)
(setq indx (1+ indx))
)
(if (and (> (sslength sst1_text) 0)
(> (sslength sst1_mtxt) 0)
)
(setq chtx_text nil)
)
)
;;;
;;;*** Function DDCHTEXT_HEIGHT
;;;This function processes the callback from the height editbox
(defun DDCHTEXT_HEIGHT (value)
(if (not (eq value chtx_heig))
(progn
(setq chtx_heig value)
(setq chtx_proc_h T)
;;;flag for processing
)
)
)
;;;*** Function DDCHTEXT_INDIVID
;;;This function obtains the individual text strings from the selection set
;;;and displays it in the edit box.
(defun DDCHTEXT_INDIVID (/)
(setq chtx_indx 0) ;index
(setq chtx_text_list '()) ;empty text list
(repeat (sslength sst1_text)
(setq chtx_text_list
(cons (entget (ssname sst1_text chtx_indx)) chtx_text_list)
)
(setq chtx_indx (1+ chtx_indx))
)
;;;pass first string to edit box
(setq chtx_indx 0)
(set_tile "string"
(cdr (assoc '1 (nth chtx_indx chtx_text_list)))
)
(if (> (sslength sst1_text) 1) ;if greater than one.
(progn ;enable "next" button
(mode_tile "next" 0)
(mode_tile "previous" 1)
)
(if (= (sslength sst1_text) 1) ;if eq to 1
(progn ;turn off buttons
(mode_tile "next" 1)
(mode_tile "previous" 1)
)
)
)
(set_tile "text_status"
(strcat (itoa (+ chtx_indx 1))
" of "
(itoa (sslength sst1_text))
)
)
)
;;;*** Function DDCHTEXT_INITIAL
;;;Sets the dialog values
(defun DDCHTEXT_INITIAL (/)
(setq chtx_dpoi nil)
;;;set message tile
(set_tile "error"
(if (eq chtx_objt "Text")
(strcat (itoa (sslength sst1_text))
" Text object(s) found..."
)
(strcat (itoa (sslength sst1_mtxt))
" Mtext objects found..."
)
)
)
;;;set all variables for tiles...
(DDCHTEXT_GETINFO)
;;;check heights to see if they vary
(if (not chtx_heig)
(if (eq (apply 'max chtx_hlis) (apply 'min chtx_hlis))
(setq chtx_heig (rtos (car chtx_hlis)))
(setq chtx_heig "Varies")
)
)
;;;check rotations to see if they vary
(if (eq chtx_objt "Text")
(if (not chtx_rota)
(if (eq (apply 'max chtx_rlis) (apply 'min chtx_rlis))
(setq chtx_rota (rtos (car chtx_rlis)))
(setq chtx_rota "Varies")
)
)
)
;;;check widths to see if they vary
(if (not chtx_widt)
(if (eq (apply 'max chtx_wlis) (apply 'min chtx_wlis))
(setq chtx_widt (rtos (car chtx_wlis)))
(setq chtx_widt "Varies")
)
)
;;;check obliquing angles to see if they vary
(if (eq chtx_objt "Text")
(if (not chtx_obli)
(if (eq (apply 'max chtx_olis) (apply 'min chtx_olis))
(setq chtx_obli (rtos (car chtx_olis)))
(setq chtx_obli "Varies")
)
)
)
;;;check justifications to see if they vary
(if (eq chtx_objt "Text")
(if (not chtx_just)
(progn
(setq chtx_flag (car chtx_jlis))
(foreach n chtx_jlis
(if (not (eq chtx_flag n))
(setq chtx_just "Varies")
)
)
(if (not (eq chtx_just "Varies"))
(setq chtx_just chtx_flag)
)
)
)
)
;;;check alignment points to see if they vary
(if (eq chtx_objt "Mtext")
(if (not chtx_apoi)
(progn
(setq chtx_flag (car chtx_alis))
(foreach n chtx_alis
(if (not (eq chtx_flag n))
(setq chtx_apoi "Varies")
)
)
(if (not (eq chtx_apoi "Varies"))
(setq chtx_apoi chtx_flag)
)
)
)
)
;;;check directions to see if they vary
(if (eq chtx_objt "Mtext")
(if (not chtx_dpoi)
(progn
(setq chtx_flag (car chtx_dlis))
(foreach n chtx_dlis
(if (not (eq chtx_flag n))
(setq chtx_dpoi "Varies")
)
)
(if (not (eq chtx_dpoi "Varies"))
(setq chtx_dpoi chtx_flag)
)
)
)
)
;;;check styles to see if they vary
(setq chtx_test (car chtx_slis))
;;;set default style
(setq chtx_styl chtx_test)
(foreach n chtx_slis
(if (not (eq n chtx_test))
(setq chtx_styl "Varies") ;change default style
)
)
;;;build style list of all non externally referenced styles in drawing
(setq chtx_styl_list (list (cdr (assoc '2 (tblnext "STYLE" T)))))
;;;first style
(while (setq chtx_data (tblnext "STYLE")) ;get next one
(if (not (eq (logand (cdr (assoc '70 chtx_data)) 16) 16))
;;;If not externally referenced...
(progn
(setq chtx_styl_name (cdr (assoc '2 chtx_data)))
(setq chtx_styl_list (cons chtx_styl_name chtx_styl_list))
;;;add to list
)
)
)
;;;sort style name list alphabetially
(setq chtx_styl_list (acad_strlsort chtx_styl_list))
;;;add Varies to list
(if (eq chtx_styl "Varies")
(setq chtx_styl_list (cons "Varies" chtx_styl_list))
)
;;;set the tiles
;;;set the height tile
(set_tile "height" chtx_heig)
(if (eq chtx_just "Align")
(progn
(mode_tile "height" 1)
(mode_tile "height_pick" 1)
)
)
;;;The text rotation
(if (eq chtx_objt "Text")
(progn
(mode_tile "rotation" 0)
(set_tile "rotation" chtx_rota)
(if (or (eq chtx_just "Align")
(eq chtx_just "Fit")
)
(progn
(mode_tile "rotation" 1)
(mode_tile "rotation_pick" 1)
)
)
)
(mode_tile "rotation" 1)
)
;;;The text width
(set_tile "width_factor" chtx_widt)
(if (eq chtx_just "Fit")
(progn
(mode_tile "width_factor" 1)
(mode_tile "width_pick" 1)
)
)
;;;The text obliquing angle
(if (eq chtx_objt "Text")
(progn
(mode_tile "obliquing" 0)
(set_tile "obliquing" chtx_obli)
)
(mode_tile "obliquing" 1)
)
;;;The justification list
(setq chtx_just_list
(list "Left" "Right" "Fit" "BLeft"
"BRight" "BCenter" "Middle" "MLeft"
"MRight" "MCenter" "TLeft" "TRight"
"TCenter" "Align" "Center"
)
)
;;;add "Varies" to list if needed...
(if (eq chtx_just "Varies")
(setq chtx_just_list (cons "Varies" chtx_just_list))
)
(setq chtx_just_list (acad_strlsort chtx_just_list))
;;;sort alphabetically
;;;map justification list
(if (eq chtx_objt "Text")
(progn
(start_list "justification")
(mapcar 'add_list chtx_just_list)
(end_list)
;;;The justification list default
(mode_tile "justification" 0)
(set_tile "justification"
(itoa (show_nth chtx_just chtx_just_list))
)
)
(mode_tile "justification" 1)
)
;;;The attachment point list
(setq chtx_apoi_list
(list "TopLeft" "TopCenter" "TopRight"
"MiddleLeft" "MiddleCenter" "MiddleRight"
"BottomLeft" "BottomCenter" "BottomRight"
)
)
;;;add "Varies" to list if needed...
(if (eq chtx_apoi "Varies")
(setq chtx_apoi_list (cons "Varies" chtx_apoi_list))
)
;;;sort alphabetically
(setq chtx_apoi_list (acad_strlsort chtx_apoi_list))
;;;map attachment points list
(if (eq chtx_objt "Mtext")
(progn
(start_list "attachment")
(mapcar 'add_list chtx_apoi_list)
(end_list)
;;;The attachment point list default
(mode_tile "attachment" 0)
(set_tile "attachment"
(itoa (show_nth chtx_apoi chtx_apoi_list))
)
)
(mode_tile "attachment" 1)
)
;;;The direction point list
(setq chtx_dpoi_list
(list "Left to Right"
"Right to Left"
"Top to Bottom"
"Bottom to Top"
)
)
;;;add "Varies" to list if needed...
(if (eq chtx_dpoi "Varies")
(setq chtx_dpoi_list (cons "Varies" chtx_dpoi_list))
)
;;;sort alphabetically
(setq chtx_dpoi_list (acad_strlsort chtx_dpoi_list))
;;;map direction list
(if (eq chtx_objt "Mtext")
(progn
(start_list "direction")
(mapcar 'add_list chtx_dpoi_list)
(end_list)
;;;The direction list default
(mode_tile "direction" 0)
(set_tile "direction"
(itoa (show_nth chtx_dpoi chtx_dpoi_list))
)
)
(mode_tile "direction" 1)
)
;;;enable the Edit Text button
(if (eq chtx_objt "Text")
(mode_tile "text_button" 0)
(mode_tile "text_button" 1)
)
;;;set the style list
;;;map style list into list box
(start_list "styles")
(mapcar 'add_list chtx_styl_list)
(end_list)
;;;show the current style
(set_tile "styles"
(itoa (show_nth chtx_styl chtx_styl_list))
)
)
;;;*** Function DDCHTEXT_JUST
;;;This function is the runtime of the justification list box.
(defun DDCHTEXT_JUST (value)
(setq chtx_just (nth (atoi value) chtx_just_list))
;;;set the justification
(setq chtx_proc_j T) ;this box was selected
;;;enable all tiles
(mode_tile "height" 0)
(mode_tile "height_pick" 0)
(mode_tile "rotation" 0)
(mode_tile "rotation_pick" 0)
(mode_tile "width_factor" 0)
(mode_tile "width_pick" 0)
(if (eq chtx_just "Fit")
(progn ;disable tiles
(mode_tile "rotation" 1)
(mode_tile "rotation_pick" 1)
(mode_tile "width_factor" 1)
(mode_tile "width_pick" 1)
)
)
(if (eq chtx_just "Align")
(progn
;;;disable tiles
(mode_tile "height" 1)
(mode_tile "height_pick" 1)
(mode_tile "rotation" 1)
(mode_tile "rotation_pick" 1)
)
)
)
;;;
;;;*** Function DDCHTEXT_REPLACE_STRING
(defun DDCHTEXT_REPLACE_STRING (value)
(setq chtx_text_list
(subst (subst ;new text element
(cons 1 value) ;new text
(assoc 1 (nth chtx_indx chtx_text_list)) ;old text
(nth chtx_indx chtx_text_list) ;text data list
)
(nth chtx_indx chtx_text_list) ;old text element
chtx_text_list ;text list
)
)
)
;;;*** Function DDCHTEXT_TEXT_INIT
;;;This function initializes the Text dialog
(defun DDCHTEXT_TEXT_INIT (/)
(if (not chtx_text_type)
(setq chtx_text_type "Global") ;default
)
(if (eq chtx_text_type "Global")
(progn
(set_tile "global" "1")
(mode_tile "global_tile" 0)
(mode_tile "individual_tile" 1)
)
(progn
(set_tile "individual" "1")
(mode_tile "individual_tile" 0)
(mode_tile "global_tile" 1)
(ddchtext_individ)
)
)
(if chtx_srch
(set_tile "search" chtx_srch)
)
(if chtx_repl
(set_tile "replace" chtx_repl)
)
(if (not chtx_case)
(setq chtx_case "1") ;default
)
(set_tile "case_sensitive" chtx_case)
)
;;;
;;;*** Function DDCHTEXT_TEXT_NEXT
;;;This function gets the next text in the selection set and displays it in the
;;;edit box
(defun DDCHTEXT_TEXT_NEXT (/)
(setq chtx_indx (1+ chtx_indx))
;;;step up index
(set_tile "string"
(cdr (assoc '1 (nth chtx_indx chtx_text_list)))
)
(set_tile "text_status"
(strcat (itoa (+ chtx_indx 1))
" of "
(itoa (sslength sst1_text))
)
)
(if (> chtx_indx 0) ;if past first text, then
(progn
(mode_tile "previous" 0) ;enable previous button
(if (= chtx_indx (1- (length chtx_text_list))) ;if at maximum
(mode_tile "next" 1) ;disable next button
)
)
)
)
;;;
;;;*** Function DDCHTEXT_TEXT_PREV
;;;This function gets the previous text in the selection set and displays it in
;;;the edit box
(defun DDCHTEXT_TEXT_PREV (/)
(setq chtx_indx (1- chtx_indx)) ;step down index
(set_tile "string"
(cdr (assoc '1 (nth chtx_indx chtx_text_list)))
)
(set_tile "text_status"
(strcat (itoa (+ chtx_indx 1))
" of "
(itoa (sslength sst1_text))
)
)
(if (< chtx_indx (1- (length chtx_text_list)))
;;;if before last text, then
(progn
(mode_tile "next" 0) ;enable next button
(if (= chtx_indx 0) ;if at minimum
(mode_tile "previous" 1) ;disable previous button
)
)
)
)
;;;
;;;*** Function DDCHTEXT_TEXT_REPLACE
;;;This function searches the text for all items of chtx_srch and replaces them
;;;with chtx_repl.
(defun DDCHTEXT_TEXT_REPLACE (/)
(setq chtx_indx 0) ;set index
(repeat (sslength sst1_text) ;for each selected text object
;;;get text string
(setq chtx_text_sold
(cdr
(assoc '1 (entget (ssname sst1_text chtx_indx)))
)
)
(setq chtx_text_snew nil) ;clear this...
;;;if search string is less than old string in length
(if (<= (strlen chtx_srch) (strlen chtx_text_sold))
(progn
(setq chtx_char 1) ;set character position
(setq chtx_text_snew "") ;set new string
;;;as long as char index is less than or equal to the old text
(while (<= chtx_char (strlen chtx_text_sold))
;;;get the test string
(setq chtx_test
(substr chtx_text_sold chtx_char (strlen chtx_srch))
)
(if (eq
;;;is the test string equal to the...
(if (eq chtx_case "1") ;if case sensitive
chtx_test ;return actual value
(strcase chtx_test) ;else make uppercase
)
;;;...search string?
(if (eq chtx_case "1") ;if case sensitive
chtx_srch ;return actual value
(strcase chtx_srch) ;else make uppercase
)
)
(progn
(setq chtx_text_snew (strcat chtx_text_snew chtx_repl))
(setq chtx_char (1- (+ chtx_char (strlen chtx_srch))))
)
(setq chtx_text_snew
(strcat chtx_text_snew
(substr chtx_text_sold chtx_char 1)
)
)
)
(setq chtx_char (1+ chtx_char)) ;step up position
)
)
) ;end of if
;;;update the text object
(if chtx_text_snew
(progn
(setq chtx_text_enew
(subst
(cons 1 chtx_text_snew) ;new string code
(assoc '1 (entget (ssname sst1_text chtx_indx)))
;old string code
(entget (ssname sst1_text chtx_indx))
;original entity data list
)
)
(if chtx_text_enew
(entmod chtx_text_enew) ;update text object
)
) ;end of progn
) ;end of if
(setq chtx_indx (1+ chtx_indx)) ;increase index
) ;end of repeat
)
;;;*** Function DDCHTEXT_TEXT
;;;This function displays the text dialog box
(defun DDCHTEXT_TEXT (/)
(new_dialog "ddchtext_text" dcl_id) ;open the dialog box
;initialize dialog
(ddchtext_text_init)
;callbacks
(action_tile
"global"
(strcat
"(setq chtx_text_type \"Global\")"
"(ddchtext_text_init)"
)
)
(action_tile
"individual"
(strcat
"(setq chtx_text_type \"Individual\")"
"(ddchtext_text_init)"
)
)
(action_tile "next" "(ddchtext_text_next)")
(action_tile "previous" "(ddchtext_text_prev)")
(action_tile "string" "(ddchtext_replace_string $value)")
(action_tile "search" "(setq chtx_srch $value)")
(action_tile "replace" "(setq chtx_repl $value)")
(action_tile "case_sensitive" "(setq chtx_case $value)")
(action_tile
"help"
"(acad_helpdlg \"acad.hlp\" \"wpa_chgt\")"
)
(action_tile "accept" "(setq chtx_gotext T)(done_dialog)")
(start_dialog)
)
;;;*** Function DDCHTEXT_WIDTH
;;;This function processes the callback from the width editbox
(defun DDCHTEXT_WIDTH (value)
(if (not (eq value chtx_widt))
(progn
(setq chtx_widt value)
(setq chtx_proc_w T) ;flag for processing
)
)
)
;;;
;;;*** Function DDCHTEXT
;;;This function controls & executes the program.
(defun C:wpa_ddchgtext (/ chtx_ajus
;Retrieved attachment type
chtx_alis ;List of attachments
chtx_apoi ;Type of selected attachment or code 11
chtx_apoi_list ;Mtext Attachment list
;chtx_case ;Case-sensitive toggle
chtx_char ;Character position
chtx_data ;Data list
chtx_dlis ;List of directions
chtx_dpoi ;Type of selected direction
chtx_dpoi_list ;Mtext Direction list
chtx_ehei ;Height to be subst'ed
chtx_elis ;Entity data list being subst'ed
chtx_eobl ;Oblique angle to be subst'ed
chtx_erot ;rotation angle to be subst'ed
chtx_esty ;Style to be subst'ed
chtx_ewid ;Width to be subst'ed
chtx_flag ;Flag
chtx_go ;Go flag
chtx_gotext ;Flag to process text
chtx_hlis ;List of text heights
chtx_heig ;Text/Mtext height
chtx_hjus ;Horizonal justification code
chtx_hnew ;New horizonal code
chtx_indx ;Index
chtx_ipoi ;Insertion point
chtx_jlis ;List of justifications
chtx_just ;Justification
chtx_just_list ;Justification list for dialog
;chtx_objt ;Type of text object (global)
chtx_obli ;Obliqing angle
chtx_olis ;List of obliqing angles
chtx_proc_at ;Attachment processing flag
chtx_proc_dir ;Direction processing flag
chtx_proc_h ;Height processing flag
chtx_proc_j ;Justification processing flag
chtx_proc_w ;Width processing flag
;chtx_repl ;Replace string
chtx_rlis ;List of rotations
chtx_rota ;Rotation angle
chtx_slis ;List of styles
;chtx_srch ;Search string
chtx_sst1 ;User's selection set
chtx_stop ;Stopper flag
chtx_styl ;Style
chtx_styl_list ;Style list for dialog
chtx_styl_name ;Name of style for test
chtx_test ;Tester for styles
chtx_text ;Text
chtx_text_enew ;New entity
chtx_text_list ;List of text
chtx_text_snew ;New searched string replaced
chtx_text_sold ;Old searched string tested
chtx_text_type ;Type of text
chtx_vjus ;Vertical justification code
chtx_vnew ;New vertical code
chtx_widt ;Text/Mtext width
chtx_wlis ;List of widths
flag ;Flag
indx ;Index
olderr ;Old *error* handler
sst1_mtxt ;Selection set of MTEXT objects
sst1_proc ;Selection set for processing
sst1_text ;Selection set of TEXT objects
sv_blipmode ;Blipmode
sv_luprec ;Luprec
)
(se)
(sav)
(print)
(princ "\nCommand: Change Text")
(print)
(setq chtx_proc_j nil)
;;;Define error routine for this command
(defun ddchtext_error (s)
(if (/= s "wpa_chgt Function cancelled.") ;if ^c occurs...
(princ (strcat "\nError: " s))
)
(if olderr
(setq *error* olderr)
)
(princ)
)
(setq olderr *error*)
(setq *error* ddchtext_error)
;;;Set the precision for the benefit of the user...
(setq sv_luprec (getvar "LUPREC"))
(setvar "LUPREC" 2)
;;;other system variables
(setq sv_blipmode (getvar "BLIPMODE"))
(command ".UNDO" "M")
(if (not chtx_objt)
(setq chtx_objt "Text") ;default
)
;;;select objects for processing
(initget "Mtext Text")
(setq flag
(getkword
(strcat "\nProcess: Mtext/Text...<" chtx_objt ">: ")
)
)
(if flag
(setq chtx_objt flag)
)
(setq chtx_sst1 (ssget))
(if chtx_sst1
(progn
(ddchtext_gettext) ;filter out text objects
(if (eq chtx_objt "Text")
(if (or (not sst1_text) (= (sslength sst1_text) 0))
(alert "No Text objects were selected...")
(ddchtext_dialog)
)
)
(if (eq chtx_objt "Mtext")
(if (or (not sst1_mtxt) (= (sslength sst1_mtxt) 0))
(alert "No MText objects were selected...")
(ddchtext_dialog)
)
)
)
)
;;;change the text
(if (and
(or chtx_heig chtx_rota chtx_widt chtx_obli
chtx_just chtx_apoi chtx_dpoi chtx_styl
)
chtx_go
)
(progn
(setq chtx_indx 0)
(if (eq chtx_objt "Text")
(setq sst1_proc sst1_text)
(setq sst1_proc sst1_mtxt)
)
(repeat (sslength sst1_proc)
;;;get entity data list
(setq chtx_elis (entget (ssname sst1_proc chtx_indx)))
;;;text height
(if chtx_proc_h
(if (not (eq chtx_heig "Varies"))
(progn
(setq chtx_ehei (assoc '40 chtx_elis))
;;;swap old height with new
(setq chtx_elis (subst (cons 40 (atof chtx_heig))
chtx_ehei
chtx_elis
)
)
)
)
)
;;;text rotation
(if (eq chtx_objt "Text")
(if (not (eq chtx_rota "Varies"))
(progn
(setq chtx_erot (assoc '50 chtx_elis))
;;;swap old rotation with new
(setq chtx_elis
(subst (cons 50 (dtor (atof chtx_rota)))
chtx_erot
chtx_elis
)
)
)
)
)
;;;text width
(if (not (eq chtx_widt "Varies"))
(progn
(setq chtx_ewid (assoc '41 chtx_elis))
;;;swap old widht with new
(setq chtx_elis (subst (cons 41 (atof chtx_widt))
chtx_ewid
chtx_elis
)
)
)
)
;;;text obliqing angle
(if (eq chtx_objt "Text")
(if (not (eq chtx_obli "Varies"))
(progn
(setq chtx_eobl (assoc '51 chtx_elis))
;;;swap old angle with new
(setq chtx_elis
(subst (cons 51 (dtor (atof chtx_obli)))
chtx_eobl
chtx_elis
)
)
)
)
)
;;;text justification
(if (eq chtx_objt "Text")
(if chtx_proc_j
(if (not (eq chtx_just "Varies"))
(progn
;;;get horizontal & vertical justification codes
(setq chtx_hjus (assoc '72 chtx_elis))
(setq chtx_vjus (assoc '73 chtx_elis))
;;;get alignment point
(setq chtx_apoi (assoc '11 chtx_elis))
;;;get insertion point
(setq chtx_ipoi (assoc '10 chtx_elis))
;;;swap alignment point with insertion point only if "Left" justified
(if (eq chtx_just "Left")
(setq chtx_ipoi (cons 10 (cdr chtx_apoi)))
;;;if currently "Left" justified, set alignment point to be same as
;;;insertion point.
(if
(and (eq (cdr chtx_hjus) 0) (eq (cdr chtx_vjus) 0))
(setq chtx_apoi (cons 11 (cdr chtx_ipoi)))
)
)
(setq chtx_hnew
(cond
((eq chtx_just "Left") (cons 72 0))
((eq chtx_just "BLeft") (cons 72 0))
((eq chtx_just "MLeft") (cons 72 0))
((eq chtx_just "TLeft") (cons 72 0))
((eq chtx_just "Center") (cons 72 1))
((eq chtx_just "BCenter") (cons 72 1))
((eq chtx_just "MCenter") (cons 72 1))
((eq chtx_just "TCenter") (cons 72 1))
((eq chtx_just "Right") (cons 72 2))
((eq chtx_just "BRight") (cons 72 2))
((eq chtx_just "MRight") (cons 72 2))
((eq chtx_just "TRight") (cons 72 2))
((eq chtx_just "Middle") (cons 72 4))
((eq chtx_just "Align") (cons 72 3))
((eq chtx_just "Fit") (cons 72 5))
)
)
(setq chtx_vnew
(cond
((eq chtx_just "Left") (cons 73 0))
((eq chtx_just "BLeft") (cons 73 1))
((eq chtx_just "MLeft") (cons 73 2))
((eq chtx_just "TLeft") (cons 73 3))
((eq chtx_just "Center") (cons 73 0))
((eq chtx_just "BCenter") (cons 73 1))
((eq chtx_just "MCenter") (cons 73 2))
((eq chtx_just "TCenter") (cons 73 3))
((eq chtx_just "Right") (cons 73 0))
((eq chtx_just "BRight") (cons 73 1))
((eq chtx_just "MRight") (cons 73 2))
((eq chtx_just "TRight") (cons 73 3))
((eq chtx_just "Middle") (cons 73 0))
((eq chtx_just "Align") (cons 73 0))
((eq chtx_just "Fit") (cons 73 0))
)
)
;;;swap old horizontal justification with new
(setq chtx_elis (subst chtx_hnew chtx_hjus chtx_elis))
;;;swap old vertical justification with new
(setq chtx_elis (subst chtx_vnew chtx_vjus chtx_elis))
;;;substitute insertion point with new
(if (or (eq chtx_just "Fit") (eq chtx_just "Align"))
(progn
(setq
chtx_flag (getpoint (cdr (assoc '10 chtx_elis))
"\nFirst text line point:"
)
)
(if (not chtx_flag)
(setq chtx_flag (cdr (assoc '10 chtx_elis)))
)
(setq chtx_ipoi (list 10
(car chtx_flag)
(cadr chtx_flag)
(caddr chtx_flag)
)
)
)
)
(setq chtx_elis (subst chtx_ipoi
(assoc '10 chtx_elis)
chtx_elis
)
)
;;;subsitute alignment point with new
(if (or (eq chtx_just "Fit") (eq chtx_just "Align"))
(progn
(setq
chtx_flag (getpoint (cdr chtx_ipoi)
"\nSecond text line point:"
)
)
(if (not chtx_flag)
(setq chtx_flag (assoc '11 chtx_elis))
)
(setq chtx_apoi (list 11
(car chtx_flag)
(cadr chtx_flag)
(caddr chtx_flag)
)
)
)
)
(setq chtx_elis (subst chtx_apoi
(assoc '11 chtx_elis)
chtx_elis
)
)
)
)
)
)
;;;revise mtext attachment
(if (eq chtx_objt "Mtext")
(if chtx_proc_at
(progn
(setq chtx_elis
(subst
(cons 71
(cond
;;;new item
((eq chtx_apoi "TopLeft") 1)
((eq chtx_apoi "TopCenter") 2)
((eq chtx_apoi "TopRight") 3)
((eq chtx_apoi "MiddleLeft") 4)
((eq chtx_apoi "MiddleCenter") 5)
((eq chtx_apoi "MiddleRight") 6)
((eq chtx_apoi "BottomLeft") 7)
((eq chtx_apoi "BottomCenter") 😎
((eq chtx_apoi "BottomRight") 9)
)
)
(assoc '71 chtx_elis) ;old item
chtx_elis ;list
)
)
)
)
)
;;;revise mtext direction
(if (eq chtx_objt "Mtext")
(if chtx_proc_dir
(progn
(setq chtx_elis
(subst
(cons 72
(cond ;new item
((eq chtx_dpoi "Left to Right") 1)
((eq chtx_dpoi "Right to Left") 2)
((eq chtx_dpoi "Top to Bottom") 3)
((eq chtx_dpoi "Bottom to Top") 4)
)
)
(assoc '72 chtx_elis) ;old item
chtx_elis ;list
)
)
)
)
)
;;;text style
(if (not (eq chtx_styl "Varies"))
(progn
(setq chtx_esty (assoc '7 chtx_elis))
;;;swap old style with new
(setq
chtx_elis (subst (cons 7 chtx_styl) chtx_esty chtx_elis)
)
)
)
;;;update the entity
(entmod chtx_elis)
;;;set up the index
(setq chtx_indx (1+ chtx_indx))
)
)
)
(if chtx_gotext
(if (eq chtx_text_type "Individual")
;;;update the text string values (individual line editing)
(if chtx_text_list
(foreach n chtx_text_list
(entmod n)
)
)
;;;perform global text replacement
(ddchtext_text_replace)
)
)
;;;restore system variables
(setvar "LUPREC" sv_luprec)
(setvar "BLIPMODE" sv_blipmode)
(setq *error* olderr)
(princ)
)
;;;
;;;*** End of Function
;;;*** Support Functions
;;;*** Function DTOR
;;;Converts degrees to radians, where degr is degrees; returns a
;;;radian value.
;
(defun DTOR (degr)
(/ (* degr pi) 180)
)
;;;
;;;*** Function RTOD
;;;Converts radians to degrees, where radn is radian; returns a
;;;degree value.
;;;
(defun RTOD (radn)
(/ (* 180 radn) pi)
)
;;;*** (SHOW_NTH <element> <list>)
;;; This function returns an integer which is the "nth" location of the
;;; element in a list. If the element is not part of the list, it returns
;;; nil.
;;;
(defun SHOW_NTH
(show_nth_elm show_nth_lst / show_nth_ctr show_nth_stop)
(setq show_nth_ctr 0) ;counter
(setq show_nth_stop T) ;stopper
;;;if the element is a member of the list, find the nth location
(if (member show_nth_elm show_nth_lst)
(while (and ;as long as the counter is,
(<= show_nth_ctr (length show_nth_lst))
;less than/eq to list length,
(eq show_nth_stop T) ;and the stopper is on...
)
;then run this over and over...
(if (= show_nth_elm (nth show_nth_ctr show_nth_lst))
;test nth element
(setq show_nth_stop nil) ;set stopper to off
(setq show_nth_ctr (1+ show_nth_ctr)) ;then increase counter...
)
) ;end of while
(setq show_nth_ctr nil) ;set counter to nil
) ;end of if
(eval show_nth_ctr) ;return the value of the counter
)
DCL
icon : image
{
fixed_width = true;
color = 0;
width = 20;
height = 7;
key = "icon";
}
dcl_settings : default_dcl_settings { audit_level = 0; }
wpa_ddch : dialog {
label = "wpa_cad - Change Text or Mtext";
: row {
// icon;
: row {
: boxed_column {
label = "Settings";
key = "text_settings";
: row {
: column {
: edit_box {
label = "Height:";
key = "height";
mnemonic = "H";
}
: edit_box {
label = "Rotation:";
key = "rotation";
mnemonic = "R";
}
: edit_box {
label = "Width Factor:";
key = "width_factor";
mnemonic = "W";
}
: edit_box {
label = "Obliquing:";
key = "obliquing";
mnemonic = "O";
}
}
: column {
: button {
label = "Pick <";
key = "height_pick";
}
: button {
label = "Pick <";
key = "rotation_pick";
}
: button {
label = "Pick <";
key = "width_pick";
}
: button {
label = "Pick <";
key = "obliquing_pick";
}
}
}
}
spacer;
: column {
: boxed_column {
label = "Text Only";
: popup_list {
label = "Justification:";
key = "justification";
mnemonic = "J";
}
}
spacer;
: boxed_column {
label = "Mtext Only";
: popup_list {
label = "Attachment:";
key = "attachment";
edit_width = 14;
mnemonic = "A";
}
spacer;
: popup_list {
label = "Direction:";
key = "direction";
mnemonic = "D";
}
}
}
}
: column {
icon;
spacer;
spacer;
spacer;
}
}
spacer;
: row {
// icon;
: button {
label = "Edit Text Objects...";
key = "text_button";
mnemonic = "E";
}
: text {
label = " ";
alignment = centered;
}
// spacer;
spacer;
spacer;
spacer;
: popup_list {
label = "Style:";
key = "styles";
width = 20;
mnemonic = "S";
}
// }
spacer;
spacer;
spacer;
: text {
label = " ";
alignment = centered;
}
spacer;
: column {
: button {
label = /*MSG210*/"OK";
key = "accept";
mnemonic = /*MSG211*/"K";
width = 18;
is_default = true;
}
: button {
label = /*MSG210*/"Cancel";
key = "cancel";
mnemonic = /*MSG211*/"C";
width = 18;
is_cancel = true;
}
: button {
label = /*MSG210*/"Help...";
key = "help";
mnemonic = /*MSG211*/"H";
width = 18;
}
}
}
errtile;
: text {
key = "msg2";
alignment = centered;
}
}
ddchtext_text : dialog {
label = "Edit Text Objects";
: radio_column {
key = "radios";
: radio_button {
label = "Individual";
key = "individual";
mnemonic = "I";
}
: radio_button {
label = "Global";
key = "global";
mnemonic = "G";
}
: boxed_column {
key = "individual_tile";
: edit_box {
label ="Text line:";
key = "string";
mnemonic = "T";
}
: text {
key = "text_status";
}
: row {
key = "button_row";
: button {
label = "Next >";
key = "next";
mnemonic = "N";
}
: button {
label = "Previous <";
key = "previous";
mnemonic = "P";
}
}
}
spacer;
: boxed_column {
key = "global_tile";
: edit_box {
label = "Searching For:";
key = "search";
mnemonic = "S";
}
: edit_box {
label = "Replace With :";
key = "replace";
mnemonic = "R";
}
spacer;
: toggle {
label = "Case sensitive";
key = "case_sensitive";
mnemonic = "C";
}
}
}
spacer;
ok_cancel_help;
errtile;
}
