TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Shade on June 21, 2007, 11:48:48 AM
-
Anyone have a Mtext Format stripper lisp.
I would like the mtext in my drawing to match the the style set in the textstyle, not what is shown in the overrides.
Ie. My text style is Romans; the mtext is set to romans style but shows Arial and 1/2 the size.
I wish to eliminate the 1/2 size and the arial font style from the text.
Any help would be apprecited...
-
Do a search for STRIPMTEXT.
-
Do a search for STRIPMTEXT.
You might try Steve Doman (sdoman@qwest.net) as well. He wrote it.
-
Yes. :-)
http://www.theswamp.org/index.php?topic=7272.0
PS Steve's has more user options than mine. Mine strips everything.
-
I have found several linkz for the lisp but they are all dead!
Anyone have a live copy? :cry:
-
As it is in the public domain.
-
As it is in the public domain.
That looks like my old beta 4 version of StripMText, which was never completed due to a variety of reasons. Better to use v3.09 which can be downloaded at http://cadabyss.wordpress.com/
I have restarted working on the next version of StripMtext BTW. Any wish lists, comments, or suggestions gladly accepted.
-
Thanks Steve, it has been very helpful.
And you did say in the header that it was in the public domain. :-)
-
Thanks Steve, it has been very helpful.
And you did say in the header that it was in the public domain. :-)
No problemo Slim. Public Domain is correct. Thanks for posting!
-
Any wish lists, comments, or suggestions gladly accepted.
A command line version would be great.
-
Any wish lists, comments, or suggestions gladly accepted.
A command line version would be great.
You got it. Thanks for the feedback.
-
Andy and others,
Regarding a command line option, I was think of introducing a minus command "-stripmtext". In the current version, the DCL dialog makes choosing format options very easy. How do you imagine the user entering options at the command line?
I was thinking maybe the user entering a comma delimited string, like the old OSNAP command. This means the user entering a rather cryptic, hard to remember string. For font, color, stacking, paragraph, alignment, width, and tracking, the user would enter something like "F,C,S,P,A,W,T". Of course I'd include an option to pop up the options dialog from the command line.
Thanks
Just added the following claification:
"...like the old OSNAP command."
Meaning: -OSNAP command
-
Wouldn't a command line version look like this?
command: -stripmtext
Enter options: "ACFHLOPQStTW~", *=ALL, Enter= Dialog Box:
Or This:
command: -stripmtext
Remove All Formats found [Y/N]:
Remove Alignment [Y/N]:
Remove Color [Y/N]:
Remove Font [Y/N]:
Remove Height [Y/N]:
Remove Underscore [Y/N]:
Remove Overscore [Y/N]:
Remove Linefeed [Y/N]:
Remove Obliquing [Y/N]:
Remove Spacing (Stacking) [Y/N]:
Remove Tabs [Y/N]:
Remove Tracking [Y/N]:
Remove Width [Y/N]:
Remove Non-breaking Space [Y/N]:
Or you could call the subroutine directly from your lisp
(stripmtext Mtext Formats)
Where
(defun stripmtext (Mtext Formats)
(UnFormat Mtext Formats)
)
-
Thanks everyone for the help!
Appreciated
-
Wouldn't a command line version look like this?
command: -stripmtext
Enter options: "ACFHLOPQStTW~", *=ALL, Enter= Dialog Box:
Thanks CAB. I like your first suggestion because it is simple and fast. The only problem I see with it that a first time user might not understand what to do. I would need to add "?" for Help. Your other example would be slower to key in, and the user might be annoyed at having to answer all those prompts.
Or you could call the subroutine directly from your lisp
The current version exposes a function, (stripmtext ss formats), where ss is a selection set of Mtext objects and formats is a concatenated string of format codes. I added this feature per requests for a version that could be run by script. It was the quick solution. The better solution for scripts IMO, is to use the proposed command line version.
I am thinking of removing the exposed stripmtext function, and exposing John's Unformat function, (UnFormat Mtext Formats), which expects a single Mtext string and the format codes.
Actually in the next version, I am working on a totally new parsing engine, so the expose function will be something else.
Thanks everyone for the help!
Appreciated
Shade, From all of use to you "Your welcome!" .
Sorry, I didn't mean to hijack your thread. I should have started a new one regarding new features.
-
hi guys, can i ask, how about if the mtext with embedded formatting from mtext editor is nested in different levels inside blocks?how can i remove the formatting?
-
The lisp HERE (http://www.theswamp.org/index.php?topic=16740.msg204100#msg204100) is an example of how to do it.
Also see nentsel in the VLIDE help file.
-
The lisp HERE (http://www.theswamp.org/index.php?topic=16740.msg204100#msg204100) is an example of how to do it.
Also see nentsel in the VLIDE help file.
Thanks for your reply cab, i got too many text like that in a single file, if i use nentsel, it would be one by one.if only there is a way i can loop through each nested mtext.....
-
Stripping mText of formatting is a big job. Is there something specific you want to strip out of them?
You can iterate the block collection to find the mText objects you want to strip.
-
Wouldn't a command line version look like this?
command: -stripmtext
Enter options: "ACFHLOPQStTW~", *=ALL, Enter= Dialog Box:
Thanks CAB. I like your first suggestion because it is simple and fast. The only problem I see with it that a first time user might not understand what to do. I would need to add "?" for Help. Your other example would be slower to key in, and the user might be annoyed at having to answer all those prompts.
Or you could call the subroutine directly from your lisp
The current version exposes a function, (stripmtext ss formats), where ss is a selection set of Mtext objects and formats is a concatenated string of format codes. I added this feature per requests for a version that could be run by script. It was the quick solution. The better solution for scripts IMO, is to use the proposed command line version.
I am thinking of removing the exposed stripmtext function, and exposing John's Unformat function, (UnFormat Mtext Formats), which expects a single Mtext string and the format codes.
Actually in the next version, I am working on a totally new parsing engine, so the expose function will be something else.
Hi Sreve,
For what it's worth, I put John's Unformat function in my toolbox back when you and John collaborated. I'm not sure how many routines call it, but it's more than a few.
I sure miss John...
-
I sure miss John...
Joe;
Any idea of what happen to him? (John F. Uhden) - hope that he end up making a lot of money and quit, his job and he is having a lot of fun - his web site still is open :)
btw, I had the chance to talk to him (by phone) some years ago...
-
I sure miss John...
Joe;
Any idea of what happen to him? (John F. Uhden) - hope that he end up making a lot of money and quit, his job and he is having a lot of fun - his web site still is open :)
btw, I had the chance to talk to him (by phone) some years ago...
Hola Luis,
No, I don't know why he suddenly disappeared. I conversed with him via email back when he was online. But I haven't heard from him since.
You know him. He would not have checked out if he made a lot of money... I suspect what he would have done is spent more time sharing his knowledge.
-
Hola Luis,
No, I don't know why he suddenly disappeared. I conversed with him via email back when he was online. But I haven't heard from him since.
You know him. He would not have checked out if he made a lot of money... I suspect what he would have done is spent more time sharing his knowledge.
Well, hope that he is doing just fine! :)
(looking in my phone numbers here, I still have his cell...)
-
wizman,
You may try this routine.
Caution, I did very little testing.
;; CAB 10/09/2007
;; Strip Mtext within blocks
(defun c:StripBlockMtext (/ adoc text_style_name text_height)
(vl-load-com)
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark adoc)
(vlax-for blk (vla-get-blocks adoc)
;; Exclude model and paper spaces and anonymus blocks
(if (and (equal (vla-get-IsLayout blk) :vlax-false)
(equal (vla-get-IsXref blk) :vlax-false)
(/= (substr (vla-get-Name blk) 1 1) "*")
)
(vlax-for ent blk
(if (= (vla-get-objectname ent) "AcDbMText")
(progn
(setq str (strip_text (vla-get-textstring ent) "*"))
(vl-catch-all-apply 'vla-put-textstring (list ent str))
)
)
)
)
)
(vla-regen adoc acactiveviewport)
(vla-endundomark adoc)
(princ)
)
;;;=======================[ Strip_Text.lsp ]=============================
;;; Author: Charles Alan Butler Copyright© 2005-2007
;;; Version: 2.3 Jan. 26, 2006
;;; Version: 3.0 Jun. 19, 2007
;;; Purpose: Strip format characters from text or mtext string
;;; Returns: A string
;;; Sub Routines: -None
;;; Arguments: A string variable to remove formats from & Flag string of formats to remove
;;; Format Flag:
;;; * Remove All Formats found
;;; A Alignment
;;; C Color
;;; F Font
;;; H Height
;;; L Underscore
;;; O Overscore
;;; P Linefeed (Paragraph) **** ??
;;; Q Obliquing
;;; S Spacing (Stacking)
;;; t Tabs
;;; T Tracking
;;; W Width
;;; ~ Non-breaking Space
;;; % Plain Text Formatting
;;
;;;======================================================================
(defun strip_text (str fmt / skipcnt ndx newlst char fmtcode lst_len
IS_MTEXT LST NEXTCHR PT TMP)
(if (or (/= (type fmt) 'Str) (= fmt "*") (= fmt ""))
(setq fmt (vl-string->list "AaCcFfHhLlOoPpQqSsTtQqWw~%"))
(setq fmt (vl-string->list fmt))
)
(setq ndx 0
;; "fmtcode" is a list of code flags that will end with ;
fmtcode
(vl-string->list "CcFfHhTQqWwAa") ;("\C" "\F" "\H" "\T" "\Q" "\W" "\A")
)
(if (/= str "") ; skip if empty text ""
(progn
(setq lst (vl-string->list str)
lst_len (length lst)
newlst '()
is_mtext nil ; true if mtext
)
(while (< ndx lst_len)
;; step through text and find FORMAT CHARACTERS
(setq char (nth ndx lst) ; Get next character
nextchr (nth (1+ ndx) lst)
skipcnt 0
)
(cond
((and (= char 123) (= nextchr 92)) ; "{\" mtext code
(setq is_mtext t
skipcnt 1
)
)
((and (= char 125) is_mtext) ; "}"
(setq skipcnt 1)
)
((= char 37) ; code start with "%"
(if (null nextchr) ; true if % is last char in text
(setq skipcnt 1)
;; Dtext codes
(if (= nextchr 37) ; %% code found
(if (< 47 (nth (+ ndx 2) lst) 58) ; is a number
(if (vl-position 37 fmt)
;; number found so fmtcode %%nnn
;; convert the nnn to a character
(setq skipcnt 5
newlst (append newlst (list (atoi (strcat (chr (nth (+ ndx 2) lst))
(chr (nth (+ ndx 3) lst))
(chr (nth (+ ndx 4) lst))
)))))
;; keep the code in the string
(setq skipcnt 5
newlst (append newlst (list 37 37 (nth (+ ndx 2) lst)
(nth (+ ndx 3) lst)
(nth (+ ndx 4) lst)
)))
)
;; else letter code, so fmtcode %%p, %%d, %%c
;; CAB note - this code does not always exist in the string
;; it is used to create the character but the actual ascii code
;; is used in the string, not the case for %%c
(if (vl-position 37 fmt)
(setq skipcnt 3
newlst (append newlst (list (cond ((= (nth (+ ndx 2) lst) "p") 177)
((= (nth (+ ndx 2) lst) "d") 176)
((= (nth (+ ndx 2) lst) "c") 216)
((= (nth (+ ndx 2) lst) "%") 37)
))))
(setq skipcnt 3
newlst (append newlst (list 37 37 (nth (+ ndx 2) lst)
)))
)
) ; endif
) ; endif
) ; endif
) ; end cond (= char "%"))
((= char 92) ; code start with "\"
;; This section processes mtext codes
(cond
;; Process Coded information
((null nextchr) ; true if \ is last char in text
(setq skipcnt 1)
) ; end cond 1
((member nextchr fmtcode) ; this code will end with ";"
;; fmtcode -> ("\C" "\F" "\H" "\T" "\Q" "\W" "\A"))
(while (/= (setq char (nth (+ skipcnt ndx) lst)) 59)
(setq skipcnt (1+ skipcnt))
)
(setq skipcnt (1+ skipcnt))
) ; end cond
;; found \U then get 7 character group
((= nextchr 85) (setq skipcnt (+ skipcnt 7)))
;; found \M then get 8 character group
((= nextchr 77) (setq skipcnt (+ skipcnt 8)))
;; found \P then replace with CR LF 13 10
;; debug do not add CR LF, just remobe \P
((= nextchr 80) ; "\P"
(if (vl-position 80 fmt)
(setq newlst (append newlst '(32))
;ndx (+ ndx 1)
skipcnt 2
)
)
) ; end cond
((= nextchr 123) ; "\{" normal brace
(setq ndx (+ ndx 1))
) ; end cond
((= nextchr 125) ; "\}" normal brace
(setq ndx (+ ndx 1))
) ; end cond
((= nextchr 126) ; "\~" non breaking space
(if (vl-position 126 fmt)
(setq newlst (append newlst '(32)) ; " "
skipcnt 2) ; end cond 9
)
)
;; 2 character group \L \l \O \o
((member nextchr '(76 108 79 111))
(setq skipcnt 2)
) ; end cond
;; Stacked text format as "[ top_txt / bot_txt ]"
((= nextchr 83) ; "\S"
(setq pt (1+ ndx)
tmp '()
)
(while
(not
(member
(setq tmp (nth (setq pt (1+ pt)) lst))
'(94 47 35) ; "^" "/" "#" seperator
)
)
(setq newlst (append newlst (list tmp)))
)
(setq newlst (append newlst '(47))) ; "/"
(while (/= (setq tmp (nth (setq pt (1+ pt)) lst)) 59) ; ";"
(setq newlst (append newlst (list tmp)))
)
(setq ndx pt
skipcnt (1+ skipcnt)
)
) ; end cond
) ; end cond stmt Process Coded information
) ; end cond (or (= char "\\")
) ; end cond stmt
;; Skip format code characters
(if (zerop skipcnt) ; add char to string
(setq newlst (append newlst (list char))
ndx (+ ndx 1)
)
;; else skip some charactersPLOTTABS
(setq ndx (+ ndx skipcnt))
)
) ; end while Loop
) ; end progn
) ; endif
(vl-list->string newlst) ; return the stripped string
) ; end defun
<edit: updated code with Tim's suggestion>
-
Alan,
Your code will try and change xrefs. To stop that I do it like
(vlax-for blk (vla-get-Blocks (vla-get-ActiveDocument (vlax-get-Acad-Object)))
(if
(and
(eqaul (vla-get-IsLayout blk) :vlax-false)
(equal (vla-get-IsXref blk) :vlax-false)
(/= (substr (vla-get-Name blk) 1 1) "*")
)
.... do your things here ...
)
)
-
Thanks Tim, I made the changes.
-
that was amazing! thanks cab and tim, you guys are very helpful.keep up!
-
ok, I think I need this .lsp code, however I have been having problems. I do not have a lot of experience with lsp.....
I found several zip files for this code, however when I save the zip to my computer and try to run lsp in acad I get an error...
It says it can not load the .dcl file. I have the dcl in the same location as the lsp but I can not move forward....
Anyone have any suggestions?
-
Is the directory containing the DCL in your support path?
-
Thank you very much!!!!!
-
I sure miss John...
Joe;
Any idea of what happen to him? (John F. Uhden) - hope that he end up making a lot of money and quit, his job and he is having a lot of fun - his web site still is open :)
btw, I had the chance to talk to him (by phone) some years ago...
Hola Luis,
No, I don't know why he suddenly disappeared. I conversed with him via email back when he was online. But I haven't heard from him since.
You know him. He would not have checked out if he made a lot of money... I suspect what he would have done is spent more time sharing his knowledge.
Hola Joe,
I just happen to noticed that John Uhden, is back to the adesk lisp ng..... just to let you know :)
http://discussion.autodesk.com/forums/thread.jspa?threadID=699106&tstart=0
(and sorry I know this is an old topic)
-
Huh... Interesting quote from Jason Piercy towards the bottom... explains quite a bit.
Anne is no longer moderating, hasn't been for a few years now. All of the previous "Facilitators" have also been relieved of their volunteer duties as of early this year. Things are not what they used to be.
-
Huh... Interesting quote from Jason Piercy towards the bottom... explains quite a bit.
Anne is no longer moderating, hasn't been for a few years now. All of the previous "Facilitators" have also been relieved of their volunteer duties as of early this year. Things are not what they used to be.
Isn't that the truth.....