; Next available MSG number is 83 ; MODULE_ID CHTEXT_LSP_ ; $Header: /sedona/develop/support/chtext.lsp 8 4/29/97 5:35p Derrl $ ;;; ;;; CHTEXT.lsp - change text ;;; ;;; Copyright 1997 by Autodesk, Inc. ;;; ;;; Permission to use, copy, modify, and distribute this software ;;; for any purpose and without fee is hereby granted, provided ;;; that the above copyright notice appears in all copies and ;;; that both that copyright notice and the limited warranty and ;;; restricted rights notice below appear in all supporting ;;; documentation. ;;; ;;; AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS. ;;; AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF ;;; MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE. AUTODESK, INC. ;;; DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE ;;; UNINTERRUPTED OR ERROR FREE. ;;; ;;; Use, duplication, or disclosure by the U.S. Government is subject to ;;; restrictions set forth in FAR 52.227-19 (Commercial Computer ;;; Software - Restricted Rights) and DFAR 252.227-7013(c)(1)(ii) ;;; (Rights in Technical Data and Computer Software), as applicable. ;;; ;;;--------------------------------------------------------------------------; ;;; DESCRIPTION ;;; This is a "text processor" which operates in a global manner ;;; on all of the text entities that the user selects; i.e., the ;;; Height, Justification, Location, Rotation, Style, Text, and ;;; Width can all be changed globally or individually, and the ;;; range of values for a given parameter can be listed. ;;; ;;; The command is called with CHT from the command line at which ;;; time the user is asked to select the objects to change. ;;; ;;; Select text to change. ;;; Select objects: ;;; ;;; If nothing is selected the message "ERROR: Nothing selected." ;;; is displayed and the command is terminated. If more than 25 ;;; entities are selected the following message is displayed while ;;; the text entities are sorted out from the non-text entities. ;;; A count of the text entities found is then displayed. ;;; ;;; Verifying the selected entities... ;;; nnn text entities found. ;;; CHText: Height/Justification/Location/Rotation/Style/Text/Undo/Width: ;;; ;;; A typical example of the prompts you may encounter follows: ;;; ;;; If you select a single text entity to change and ask to change ;;; the height, the prompt looks like this: ;;; ;;; CHText: Height/Justification/Location/Rotation/Style/Text/Undo/Width: ;;; New text height for text entity. <0.08750000>: ;;; ;;; If you select more than one text entity to change and ask to change ;;; the height, the prompt looks like this: ;;; ;;; CHText: Height/Justification/Location/Rotation/Style/Text/Undo/Width: ;;; Individual/List/: ;;; ;;; Typing "L" at this prompt returns a prompt showing you the range of ;;; values that you are using for your text. ;;; ;;; Height -- Min: 0.05000000 Max: 0.10000000 Ave: 0.08392857 ;;; ;;; Typing "I" at this prompt puts you in a loop, processing the text ;;; entities you have selected one at a time, and giving the same prompt ;;; you get for a single text entity shown above. ;;; ;;; Pressing ENTER at this point puts you back at the Command: prompt. ;;; Selecting any of the other options allows you to change the text ;;; entities selected. ;;; ;;;---------------------------------------------------------------------------; (defun cht_Main ( / sset opt ssl nsset temp unctr ct_ver sslen style hgt rot txt ent loc loc1 just-idx justp justq orthom cht_ErrorHandler cht_OrgError cht_OrgCmdecho cht_OrgTexteval cht_OrgHighlight) ;; Reset if changed (setq ct_ver "2.00") ;; Internal error handler defined locally (defun cht_ErrorHandler (s) (if (/= s "Funktion abgebrochen") (if (= s "quit / beenden abbrechen") (princ) (princ (strcat "\nFehler: " s)) ) ) (eval (read U:E)) ;; Reset original error handler if there (if cht_OrgError (setq *error* cht_OrgError)) (if temp (redraw temp 1)) (ai_undo_off) ;; restore undo state (if cht_OrgCmdecho (setvar "cmdecho" cht_OrgCmdecho)) (if cht_OrgTexteval (setvar "texteval" cht_OrgTexteval)) (if cht_OrgHighlight (setvar "highlight" cht_OrgHighlight)) (princ) ) ;; Set error handler (if *error* (setq cht_OrgError *error* *error* cht_ErrorHandler) (setq *error* cht_ErrorHandler) ) ;; Set undo groups and ends with (eval(read U:G)) or (eval(read U:E)) (setq U:G "(command \"_.undo\" \"_group\")" U:E "(command \"_.undo\" \"_en\")" ) (ai_undo_on) ;; enable undo (setq cht_OrgCmdecho (getvar "cmdecho")) (setq cht_OrgHighlight (getvar "highlight")) (setvar "cmdecho" 0) (princ (strcat "\nText ändern, Version " ct_ver ", Copyright © 1997 Autodesk, Inc.")) (prompt "\nWählen Sie die zu ändernden Textobjekte.") (setq sset (ai_aselect)) (if (null sset) (progn (princ "\nKeine Objekte gewählt.") (exit) ) ) ;; Validate selection set (setq ssl (sslength sset) nsset (ssadd)) (if (> ssl 25) (princ "\nÜberprüft gewählte Objekte...") ) (while (> ssl 0) (setq temp (ssname sset (setq ssl (1- ssl)))) (if (or (= (cdr (assoc 0 (entget temp))) "TEXT") (= (cdr (assoc 0 (entget temp))) "ATTDEF") (= (cdr (assoc 0 (entget temp))) "MTEXT") ) (ssadd temp nsset) ) ) (setq ssl (sslength nsset) sset nsset unctr 0 ) (print ssl) (princ "Textobjekte gefunden.") ;; Main loop (setq opt T) (while (and opt (> ssl 0)) (setq unctr (1+ unctr)) (command "_.UNDO" "_GROUP") (initget "Position Ausrichtung Stil Höhe Drehen Breite Text Rückgängig ") (setq opt (getkword "\nHöhe/Ausrichtung/Position/Drehen/Stil/Text/Rückgängig/Breite: ")) (if opt (cond ((= opt "Rückgängig") (cht_Undo) ) ((= opt "Position") (cht_Location) ) ((= opt "Ausrichtung") (cht_Justification) ) ((= opt "Stil") (cht_Property "Stil" "Neuer Stilname" 7) ) ((= opt "Höhe") (cht_Property "Höhe" "Neue Höhe" 40) ) ((= opt "Drehen") (cht_Property "Drehen" "Neuer Drehwinkel" 50) ) ((= opt "Breite") (cht_Property "Breite" "Neuer Breitenfaktor" 41) ) ((= opt "Text") (cht_Text) ) ) (setq opt nil) ) (command "_.UNDO" "_END") ) ;; Restore (if cht_OrgError (setq *error* cht_OrgError)) (eval (read U:E)) (ai_undo_off) ;; restore undo state (if cht_OrgTexteval (setvar "texteval" cht_OrgTexteval)) (if cht_OrgHighlight (setvar "highlight" cht_OrgHighlight)) (if cht_OrgCmdecho (setvar "cmdecho" cht_OrgCmdecho)) (princ) ) ;;; Undo an entry (defun cht_Undo () (if (> unctr 1) (progn (command "_.UNDO" "_END") (command "_.UNDO" "2") (setq unctr (- unctr 2)) ) (progn (princ "\nNichts rückgängig zu machen. ") (setq unctr (- unctr 1)) ) ) ) ;;; Change the location of an entry (defun cht_Location () (setq sslen (sslength sset) style "" hgt "" rot "" txt "" ) (command "_.CHANGE" sset "" "") (while (> sslen 0) (setq ent (entget(ssname sset (setq sslen (1- sslen)))) opt (list (cadr (assoc 11 ent)) (caddr (assoc 11 ent)) (cadddr (assoc 11 ent))) ) (prompt "\nNeue Textposition: ") (command pause) (if (null loc) (setq loc opt) ) (command style hgt rot txt) ) (command) ) ;;; Change the justification of an entry (defun cht_Justification () (initget "OL OZ OR ML MZ MR UL UZ UR Ausrichten Zentrieren Einpassen Links MItte Rechts ? ") (setq sslen (sslength sset)) (setq justp (getkword "\nAusrichten/Einpassen/Zentrieren/Links/MItte/Rechts/OL/OZ/OR/ML/MZ/MR/UL/UZ/UR/: ")) (cond ((= justp "Links") (setq justp 0 justq 0 just-idx 4) ) ((= justp "Zentriert") (setq justp 1 justq 0 just-idx 5) ) ((= justp "Rechts") (setq justp 2 justq 0 just-idx 6) ) ((= justp "Ausrichten") (setq justp 3 justq 0 just-idx 1) ) ((= justp "Einpassen") (setq justp 5 justq 0 just-idx 1) ) ((= justp "OL") (setq justp 0 justq 3 just-idx 1) ) ((= justp "OZ") (setq justp 1 justq 3 just-idx 2) ) ((= justp "OR") (setq justp 2 justq 3 just-idx 3) ) ((= justp "ML") (setq justp 0 justq 2 just-idx 4) ) ((= justp "MItte") (setq justp 4 justq 0 just-idx 5) ) ((= justp "MZ") (setq justp 1 justq 2 just-idx 5) ) ((= justp "MR") (setq justp 2 justq 2 just-idx 6) ) ((= justp "UL") (setq justp 0 justq 1 just-idx 7) ) ((= justp "UZ") (setq justp 1 justq 1 just-idx 8) ) ((= justp "UR") (setq justp 2 justq 1 just-idx 9) ) ((= justp "?") (setq justp nil) ) (T (setq justp nil) ) ) (if justp (progn ;; Process them... (while (> sslen 0) (setq ent (entget (ssname sset (setq sslen (1- sslen))))) (cond ((= (cdr (assoc 0 ent)) "MTEXT") (setq ent (subst (cons 71 just-idx) (assoc 71 ent) ent)) ) ((= (cdr (assoc 0 ent)) "TEXT") (setq ent (subst (cons 72 justp) (assoc 72 ent) ent) opt (trans (list (cadr (assoc 11 ent)) (caddr (assoc 11 ent)) (cadddr (assoc 11 ent))) (cdr (assoc -1 ent)) ;; from ECS 1) ;; to current UCS ) (setq ent (subst (cons 73 justq) (assoc 73 ent) ent)) (cond ((or (= justp 3) (= justp 5)) (prompt "\nNeue Textausrichtungspunkte: ") (if (= (setq orthom (getvar "orthomode")) 1) (setvar "orthomode" 0) ) (redraw (cdr (assoc -1 ent)) 3) (initget 1) (setq loc (getpoint)) (initget 1) (setq loc1 (getpoint loc)) (redraw (cdr (assoc -1 ent)) 1) (setvar "orthomode" orthom) (setq ent (subst (cons 10 loc) (assoc 10 ent) ent)) (setq ent (subst (cons 11 loc1) (assoc 11 ent) ent)) ) ((or (/= justp 0) (/= justq 0)) (redraw (cdr (assoc -1 ent)) 3) (prompt "\nNeue Textposition: ") (if (= (setq orthom (getvar "orthomode")) 1) (setvar "orthomode" 0) ) (setq loc (getpoint opt)) (setvar "orthomode" orthom) (redraw (cdr (assoc -1 ent)) 1) (if (null loc) (setq loc opt) (setq loc (trans loc 1 (cdr (assoc -1 ent)))) ) (setq ent (subst (cons 11 loc) (assoc 11 ent) ent)) ) ) ) ) (entmod ent) ) ) (progn ;; otherwise list options (textpage) (princ "\nAusrichtungsoptionen:\n") (princ "\t OL OZ OR\n") (princ "\t ML MZ MR\n") (princ "\t UL UZ UR\n") (princ "\t Links Zentriert Rechts\n") (princ "\tAusrichten MItte Einpassen\n") (princ "\nDrücken Sie die Eingabetaste, um fortzufahren: ") (grread) (princ "\r ") (graphscr) ) ) (command) ) ;;; Change the text of an object (defun cht_Text ( / ans) (setq sslen (sslength sset)) (initget "Global Einzeln Neueingabe ") (setq ans (getkword "\nText suchen und ersetzten. Einzeln/Neueingabe/:")) (setq cht_OrgTexteval (getvar "texteval")) (setvar "texteval" 1) (cond ((= ans "Einzeln") (progn (initget "Ja Nein ") (setq ans (getkword "\nText in Dialogfeld bearbeiten? :")) ) (while (> sslen 0) (redraw (setq sn (ssname sset (setq sslen (1- sslen)))) 3) (setq ss (ssadd)) (ssadd (ssname sset sslen) ss) (if (= ans "Nein") (cht_Edit ss) (command "_.DDEDIT" sn "") ) (redraw sn 1) ) ) ((= ans "Neueingabe") (while (> sslen 0) (setq ent (entget (ssname sset (setq sslen (1- sslen))))) (redraw (cdr (assoc -1 ent)) 3) (prompt (strcat "\nAlter Text: " (cdr (assoc 1 ent)))) (setq nt (getstring T "\nNeuer Text: ")) (redraw (cdr (assoc -1 ent)) 1) (if (> (strlen nt) 0) (entmod (subst (cons 1 nt) (assoc 1 ent) ent)) ) ) ) (T (cht_Edit sset) ;; Change all ) ) (setvar "texteval" cht_OrgTexteval) ) ;;; The old CHGTEXT command - rudimentary text editor (defun C:CHGTEXT () (cht_Edit nil)) (defun cht_Edit (objs / last_o tot_o ent o_str n_str st s_temp n_slen o_slen si chf chm cont ans class) ;; Select objects if running standalone (if (null objs) (setq objs (ssget)) ) (setq chm 0) (if objs (progn ;; If any objects selected (if (= (type objs) 'ENAME) (progn (setq ent (entget objs)) (princ (strcat "\nBestehende Zeichenfolge: " (cdr (assoc 1 ent)))) ) (if (= (sslength objs) 1) (progn (setq ent (entget (ssname objs 0))) (princ (strcat "\nBestehende Zeichenfolge: " (cdr (assoc 1 ent)))) ) ) ) (setq o_str (getstring "\nSuchzeichenfolge : " t)) (setq o_slen (strlen o_str)) (if (/= o_slen 0) (progn (setq n_str (getstring "\nNeue Zeichenfolge : " t)) (setq n_slen (strlen n_str)) (setq last_o 0 tot_o (if (= (type objs) 'ENAME) 1 (sslength objs) ) ) ;; For each selected object... (while (< last_o tot_o) (setq class (cdr (assoc 0 (setq ent (entget (ssname objs last_o)))))) (if (or (= "TEXT" class) (= "MTEXT" class) ) (progn (setq chf nil si 1) (setq s_temp (cdr (assoc 1 ent))) (while (= o_slen (strlen (setq st (substr s_temp si o_slen)))) (if (= st o_str) (progn (setq s_temp (strcat (if (> si 1) (substr s_temp 1 (1- si)) "" ) n_str (substr s_temp (+ si o_slen)) ) ) (setq chf t) ;; Found old string (setq si (+ si n_slen)) ) (setq si (1+ si)) ) ) (if chf (progn ;; Substitute new string for old ;; Modify the TEXT entity (entmod (subst (cons 1 s_temp) (assoc 1 ent) ent)) (setq chm (1+ chm)) ) ) ) ) (setq last_o (1+ last_o)) ) ) ;; else go on to the next line... ) ) ) (if (/= (type objs) 'ENAME) ;; Print total lines changed (if (/= (sslength objs) 1) (princ (strcat (rtos chm 2 0) " Textzeilen geändert.")) ) ) (terpri) ) ;;; Main procedure for manipulating text entities (defun cht_Property (typ prmpt fld / temp ow nw ent tw sty w hw lw sslen n sn ssl) (if (= (sslength sset) 1) ;; Special case if there is only ;; one entity selected ;; Process one entity. (cht_ProcessOne) ;; Else (progn ;; Set prompt string. (cht_SetPrompt) (if (= nw "Liste") ;; Process List request. (cht_ProcessList) (if (= nw "Individuell") ;; Process Individual request. (cht_ProcessIndividual) (if (= nw "Wählen") ;; Process Select request. (cht_ProcessSelect) ;; Else (progn (if (= typ "Drehen") (setq nw (* (/ nw 180.0) pi)) ) (if (= (type nw) 'STR) (if (not (tblsearch "style" nw)) (progn (princ (strcat nw ": Stil nicht gefunden. ")) ) (cht_ProcessAll) ) (cht_ProcessAll) ) ) ) ) ) ) ) ) ;;; Change all of the entities in the selection set (defun cht_ProcessAll (/ hl temp) (setq sslen (sslength sset)) (setq hl (getvar "highlight")) (setvar "highlight" 0) (while (> sslen 0) (setq temp (ssname sset (setq sslen (1- sslen)))) (entmod (subst (cons fld nw) (assoc fld (setq ent (entget temp))) ent ) ) ) (setvar "highlight" hl) ) ;;; Change one text entity (defun cht_ProcessOne () (setq temp (ssname sset 0)) (setq ow (cdr (assoc fld (entget temp)))) (if (= opt "Drehen") (setq ow (/ (* ow 180.0) pi)) ) (redraw (cdr (assoc -1 (entget temp))) 3) (initget 0) (if (= opt "Stil") (setq nw (getstring (strcat prmpt " <" ow ">: "))) (setq nw (getreal (strcat prmpt " <" (rtos ow 2) ">: "))) ) (if (or (= nw "") (= nw nil)) (setq nw ow) ) (redraw (cdr (assoc -1 (entget temp))) 1) (if (= opt "Drehen") (setq nw (* (/ nw 180.0) pi)) ) (if (= opt "Stil") (if (null (tblsearch "style" nw)) (princ (strcat nw ": Stil nicht gefunden. ")) (entmod (subst (cons fld nw) (assoc fld (setq ent (entget temp))) ent ) ) ) (entmod (subst (cons fld nw) (assoc fld (setq ent (entget temp))) ent ) ) ) ) ;;; Set the prompt string (defun cht_SetPrompt () (if (= typ "Stil") (progn (initget "Einzeln Liste Neu Wählen ") (setq nw (getkword (strcat "\nEinzeln/Liste/Stil wählen/<" prmpt " für alle Textobjekte" ">: "))) (if (or (= nw "") (= nw nil) (= nw "Enter")) (setq nw (getstring (strcat prmpt " für alle Textobjekte" ": "))) ) ) (progn (initget "Liste Einzeln " 1) (setq nw (getreal (strcat "\nEinzeln/Liste/<" prmpt " für alle Textobjekte" ">: "))) ) ) ) ;;; Process List request (defun cht_ProcessList () (setq unctr (1- unctr)) (setq sslen (sslength sset)) (setq tw 0) (while (> sslen 0) (setq temp (ssname sset (setq sslen (1- sslen)))) (if (= typ "Stil") (progn (if (= tw 0) (setq tw (list (cdr (assoc fld (entget temp))))) (progn (setq sty (cdr (assoc fld (entget temp)))) (if (not (member sty tw)) (setq tw (append tw (list sty))) ) ) ) ) (progn (setq tw (+ tw (setq w (cdr (assoc fld (entget temp)))))) (if (= (sslength sset) (1+ sslen)) (setq lw w hw w)) (if (< hw w) (setq hw w)) (if (> lw w) (setq lw w)) ) ) ) (if (= typ "Drehen") (setq tw (* (/ tw pi) 180.0) lw (* (/ lw pi) 180.0) hw (* (/ hw pi) 180.0)) ) (if (= typ "Stil") (progn (princ (strcat "\n" typ "(s) -- ")) (princ tw) ) (princ (strcat "\n" typ " -- Min: " (rtos lw 2) "\t Max: " (rtos hw 2) "\t Durchschn.: " (rtos (/ tw (sslength sset)) 2) ) ) ) ) ;;; Process Individual request (defun cht_ProcessIndividual () (setq sslen (sslength sset)) (while (> sslen 0) (setq temp (ssname sset (setq sslen (1- sslen)))) (setq ow (cdr (assoc fld (entget temp)))) (if (= typ "Drehen") (setq ow (/ (* ow 180.0) pi)) ) (initget 0) (redraw (cdr (assoc -1 (entget temp))) 3) (if (= typ "Stil") (progn (setq nw (getstring (strcat "\n" prmpt " <" ow ">: "))) ) (progn (setq nw (getreal (strcat "\n" prmpt " <" (rtos ow 2) ">: "))) ) ) (if (or (= nw "") (= nw nil)) (setq nw ow) ) (if (= typ "Drehen") (setq nw (* (/ nw 180.0) pi)) ) (entmod (subst (cons fld nw) (assoc fld (setq ent (entget temp))) ent ) ) (redraw (cdr (assoc -1 (entget temp))) 1) ) ) ;;; Process the Select option (defun cht_ProcessSelect () (princ "\nZu suchender Stilname? <*>: ") (setq sn (xstrcase (getstring)) n -1 nsset (ssadd) ssl (1- (sslength sset)) ) (if (or (= sn "*") (null sn) (= sn "")) (setq nsset sset sn "*") (while (and sn (< n ssl)) (setq temp (ssname sset (setq n (1+ n)))) (if (= (cdr (assoc 7 (entget temp))) sn) (ssadd temp nsset) ) ) ) (princ (strcat "\nStil: " sn)) (print (setq ssl (sslength nsset))) (princ "Objekte gefunden.") ) ;;; Check to see if AI_UTILS is loaded, If not, try to find it, ;;; and then try to load it. If it can't be found or can't be ;;; loaded, then abort the loading of this file immediately. (cond ((and ai_dcl (listp ai_dcl))) ; it's already loaded. ((not (findfile "ai_utils.lsp")) ; find it (ai_abort "CHT" nil) ) ((eq "failed" (load "ai_utils" "failed")) ; load it (ai_abort "CHT" nil) ) ) ;;; If we get this far, then AI_UTILS.LSP is loaded and it can ;;; be assumed that all functions defined therein are available. ;;; Next, check to see if ACADAPP.EXP has been xloaded, and abort ;;; if the file can't be found or xloaded. Note that AI_ACADAPP ;;; does not abort the running application itself (so that it can ;;; also be called from within the command without also stopping ;;; an AutoCAD command currently in progress). (if (not (ai_acadapp)) (ai_abort "CHT" nil)) ;;; The C: function definition (defun c:cht () (cht_Main)) (princ "\n\tBefehl CHT geladen.") (princ)