TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: One Shot on April 20, 2005, 05:27:24 PM
-
Is there a lisp to merge text styles out there somewhere?
Thank you,
Brad
-
Not sure where I got this lisp, but it's what I use.
;; To see the styles in a DWG enter -style at the command line, then ?
;; This changes text & Mtest from one style to another
;; The old style is still in the drawing
(defun c:Alan2A5()
(StyleChange "Alan1" "A5-8")
(princ)
)
(defun c:AlanSmall2A3()
(StyleChange "Alan Small" "A3-8")
(princ)
)
(defun StyleChange (OlSty NuSty / filterList ss NuStyList entList
NuEntList NextEnt)
;;fix the case
(setq OlSty (strcase OlSty))
;;fix the case
(setq NuSty (strcase NuSty))
;;build a filter to select only text with that style
;;Note: DXF group code 7 is the style of a text entity
;; 0 is the entity type
(setq FilterList (list '(0 . "TEXT,MTEXT") (cons 7 OlSty)))
(cond
((null(setq ss (ssget "X" FilterList)));put the text in a selection set.
(alert (strcat "Found No text with style "OlSty))
)
(
;;check and make sure NuSty exist
(tblsearch "STYLE" NuSty)
;;make a dotted pair
(setq NuStyList (cons 7 NuSty))
;;set a counter
(setq n 0)
;;grab the first ent in the ss
(setq NextEnt (ssname ss n))
;;loop until all ents changed
(while NextEnt
;;get the list
(setq EntList (entget NextEnt))
;;get the old style
(setq OlStyLst (assoc 7 EntList))
;;replace it in the list
(setq NuEntList (subst NuStyList OlStyLst EntList))
;;change the ent
(entmod NuEntList)
;;update the screen
(entupd (cdr (assoc -1 NuEntList)))
;;increment
(setq n (1+ n))
;;grab next
(setq NextEnt (ssname ss n))
) ;_ end of while
(alert (strcat (itoa n) " Items Changed "))
)
(
;;otherwise you blew it.
T
(alert (strcat "Hey You,\n\n"
NuSty
" doesn't exist!"
) ;_ end of strcat
) ;_ end of alert
)
) ;_ end of cond
(princ)
) ;_ end of defun
So you could call the routine with this:
(defun c:BCtxtfix()
(StyleChange "DWGTITLE" "DWGTITLES")
(StyleChange "HANDDWGTITLE" "DWGTITLES")
(StyleChange "HANDWGTITLE" "DWGTITLES")
(StyleChange "CONDHAND" "DWGTITLES")
(princ)
)
-
Is there a lisp to merge text styles out there somewhere?
Thank you,
Brad
Hi Brad,try this from Alan
; Design by Alan Handerson
;ADDT = combine line(s) of text to 1st line of text selected
(defun C:ADDT (/ ES1 EG1 TT ES2 EG2)
(setq ES1 (entsel "\nSelect 1st Line of Text to Combine ? "))
(while ES1
(setq EG1 (entget (car ES1)))
(setq TT (cdr (assoc 1 EG1)))
(setq ES2 (entsel "\nSelect Text to combine ? "))
(while ES2
(setq EG2 (entget (car ES2)))
(setq TT (strcat TT " " (cdr (assoc 1 EG2))))
(entdel (cdr (assoc -1 EG2)))
(setq ES2 (entsel "\nSelect another Line of Text to combine ? "))
)
(setq EG1 (subst (cons 1 TT) (assoc 1 EG1) EG1))
(entmod EG1)
(setq ES1 (entsel "\nSelect next 1st Line of Text to Combine ? "))
)
(princ)
)
-
just thought I should mention.. ^^ that Alan Henderson is not this Alan Henderson... (seriously !)
I know there's at least one other with the same name posting on CAD forums, primarily the Autodesk website using that name and something like acad solutions
BUT IT AIN'T ME !!!
-
One thing to note here hendie is that
; Design by Alan Handerson
is not spelled the same way you spell your hEnderson.
-
well spotted.. but I should just clarify just in case...
-
Well you couldve accepted praise for his work,no one wouldve noticed. :)
-
Yes we would've. Hendie does better work and has a different style.
-
:oops: :oops: :oops:
-
I have added the to the lisp to purge out the text styles. But with no luck.
Can someone please tell what I did wrong?
)
(command "_.-purge" "textstyles" "DWGTITLE,HANDDWGTITLE,HANDWGTITLE,CONDHAND")
(command "_.regen")
(command "_.undo" "end")
(setvar "cmdecho" 1)
(princ)
;; To see the styles in a DWG enter -style at the command line, then ?
;; This changes text & Mtest from one style to another
;; The old style is still in the drawing
(defun c:BCtxtfix()
(StyleChange "DWGTITLE" "DWGTITLES")
(StyleChange "HANDDWGTITLE" "DWGTITLES")
(StyleChange "HANDWGTITLE" "DWGTITLES")
(StyleChange "HANDWGTITLES" "DWGTITLES")
(StyleChange "CONDHAND" "DWGTITLES")
(princ)
)
(defun StyleChange (OlSty NuSty / filterList ss NuStyList entList
NuEntList NextEnt)
;;fix the case
(setq OlSty (strcase OlSty))
;;fix the case
(setq NuSty (strcase NuSty))
;;build a filter to select only text with that style
;;Note: DXF group code 7 is the style of a text entity
;; 0 is the entity type
(setq FilterList (list '(0 . "TEXT,MTEXT") (cons 7 OlSty)))
(cond
((null(setq ss (ssget "X" FilterList)));put the text in a selection set.
(alert (strcat "Found No text with style "OlSty))
)
(
;;check and make sure NuSty exist
(tblsearch "STYLE" NuSty)
;;make a dotted pair
(setq NuStyList (cons 7 NuSty))
;;set a counter
(setq n 0)
;;grab the first ent in the ss
(setq NextEnt (ssname ss n))
;;loop until all ents changed
(while NextEnt
;;get the list
(setq EntList (entget NextEnt))
;;get the old style
(setq OlStyLst (assoc 7 EntList))
;;replace it in the list
(setq NuEntList (subst NuStyList OlStyLst EntList))
;;change the ent
(entmod NuEntList)
;;update the screen
(entupd (cdr (assoc -1 NuEntList)))
;;increment
(setq n (1+ n))
;;grab next
(setq NextEnt (ssname ss n))
) ;_ end of while
(alert (strcat (itoa n) " Items Changed "))
)
(
;;otherwise you blew it.
T
(alert (strcat "Hey You,\n\n"
NuSty
" doesn't exist!"
) ;_ end of strcat
) ;_ end of alert
)
(command "_.-purge" "textstyles" "DWGTITLE,HANDDWGTITLE,HANDWGTITLE,CONDHAND")
(command "_.regen")
(command "_.undo" "end")
(setvar "cmdecho" 1)
(princ)
)
) ;_ end of cond
(princ)
) ;_ end of defun
I would like it to automatically purge with out asking yes or no>
Thank you,
Brad