Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Create layer from highlighting words in text or mtext

7 REPLIES 7
SOLVED
Reply
Message 1 of 8
TCCS-Admin
705 Views, 7 Replies

Create layer from highlighting words in text or mtext

I want to create a layer from selecting only some words from an mtext or text entitty.

Is it possible to highlight and select only part of the text from an mtext using a lisp routine ? similar to how Adobe Reader can select text.

 

highlight text.GIF

7 REPLIES 7
Message 2 of 8
Lee_Mac
in reply to: TCCS-Admin

To my knowledge there is no way using LISP to highlight sections of MText through the MText editor, nor determine which part of MText has been selected.

Message 3 of 8
TCCS-Admin
in reply to: Lee_Mac

Thanks Lee,

  I suspected that might be the case.

 

Paul

Message 4 of 8
pbejse
in reply to: TCCS-Admin

What you can do is pass the MTEXT/TEXT String to a lsit box and select the name from there.

 

I wrote a routien similar to that before for my so called "Lazy Typist" staff

 

(defun c:LayerFromText(/ CDiaStr ListBoxDia CollectStr lst
                         StringList StrListS a Str RepStr b fnSTR)
(vl-load-com)
(defun CDiaStr  ( / fnSTR)
       (setq StrDiaFnme (vl-filename-mktemp "tmp.DCL"))
       (setq fnSTR (open StrDiaFnme "a"))
       (write-line
             "dcl_settings : default_dcl_settings { audit_level = 3; }
  GrabLayerNAme : dialog 
  { label = \"\"; key= \"Taytol\";
  : list_box { key = \"StrListS\"; multiple_select =
  true; width = 20; height = 20; } spacer ;
  ok_cancel;
  }"  fnSTR)
              (close fnSTR) T
       )
;;;       List Box Dialog 	;;;
(defun ListBoxDia (DiaName DiaKey Title Lst)
        (setq StrDIA (load_dialog StrDiaFnme))
  (if (not (new_dialog DiaName StrDIA))
   (exit)
     )
  (start_list DiaKey)
   (mapcar 'add_list Lst)
   (end_list)
        (set_tile "Taytol" Title)
  (action_tile DiaKey (vl-prin1-to-string
         (quote (set (setq dd (read DiaKey)) (get_tile $key)))))
  (action_tile "accept" "(done_dialog 1)")
    (action_tile "cancel" "(done_dialog 0)")
  (start_dialog)
    (unload_dialog StrDIA)
        (mapcar '(lambda (x)
                               (atoi (chr x)))
                        (vl-remove
                              32
                              (vl-string->list (eval (read DiaKey)))))
         )
;;;      Collect String from List 	;;;
(defun CollectStr  (LstS LstC)
      (apply 'Strcat
             (mapcar '(lambda (y) (strcat (nth y LstC) " ")) LstS))
      )
(defun StringList (ent / Str i Lst)
  (setq Str (cdr (assoc 1 (entget  (ssname ent 0))))
        Str (LM:UnFormat (cdr (assoc 1 (setq Entype (entget  (ssname a 0)))))
	      (if (equal  (cdr (assoc 0 Entype)) "MTEXT") T nil)))
   (while
         (setq i (vl-string-search " " str))
           (setq Lst (cons (substr str 1 i) Lst))
           (setq str (substr str (+ 2 i)))
         )
   (reverse (cons str Lst)))  
;;;		Main Function		;;;
  (setq a (ssget "_+.:S:E:L" '((0 . "*TEXT"))))
  
	(setq StrList (StringList a))
	(CDiaStr)
        (Setq RepStr (CollectStr
                                   (ListBoxDia
                                         "GrabLayerNAme"
                                         "StrListS"
                                         "Select String to Follow"
                                         StrList)
                                   StrList))
  	(setq RepStr (lisped RepStr))
	(vl-file-delete StrDiaFnme)
  	(cond ((and
		 (or (not (eq RepStr ""))
		     (/= RepStr 0)
		 )
		 (setq objs (ssget ":L"))
		 (repeat (sslength objs)
		   (setq TEnt (Entget (ssname objs 0)))
		   (entmod (subst (cons 8 (vl-string-translate " " "-"
					(vl-string-trim "'\" " RepStr)))
			     (assoc 8 TEnt)
			     TEnt
		      )
	      )
		   (ssdel (ssname objs 0) objs)
		 )
	       )
	      )
	  )
)


;;;	Unformat Text	;;;
;;;      Lee Mac	;;;
(defun LM:UnFormat ( str mtx / _Replace regex ) (vl-load-com)
  ;; © Lee Mac 2010
  
  (defun _Replace ( new old str )
    (vlax-put-property regex 'pattern old) (vlax-invoke regex 'replace str new)
  )
  (setq regex (vlax-get-or-create-object "VBScript.RegExp"))  
  (mapcar
    (function
      (lambda ( x ) (vlax-put-property regex (car x) (cdr x)))
    )
    (list (cons 'global actrue) (cons 'ignorecase acfalse) (cons 'multiline actrue))
  )
  (mapcar
    (function
      (lambda ( x ) (setq str (_Replace (car x) (cdr x) str)))
    )
   '(
      ("Ð"       . "\\\\\\\\")
      (" "       . "\\\\P|\\n|\\t")
      ("$1"      . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
      ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
      ("$1$2"    . "\\\\(\\\\S)|[\\\\](})|}")
      ("$1"      . "[\\\\]({)|{")
    )
  )
  (setq str
    (if mtx
      (_Replace "\\\\" "Ð" (_Replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
      (_Replace "\\"   "Ð" str)
    )
  )
  (vlax-release-object regex)
  str
)

What it does select a TEXT/MTEXT displayes a list box for selection, and shows an edit box if you want to modify the string, assigns the layer to the selected objects

 

a blank space will be translated to a dash synbol i.e "his String" to this-String"

Kudos to Lee Macs Unformat Routine

 

 

HTH

 

 

Message 5 of 8
_Tharwat
in reply to: TCCS-Admin

Fantastic idea pBe and a very great codes indeed .

 

it is good to add error trap to catch any errors if the user pressed cancel while codes are being ruuning .

 

Best regards.

 

Tharwat

Message 6 of 8
pbejse
in reply to: _Tharwat

Thank you for the compliment Tharwat.

but this code was done in haste. bunch of codes cobbled together, need to write it that before the IT group here blocks this webiste again. Its more like i'm giving the OP an idea and he can pick up from there.

 

and yes iit has virutally no error trapping. Hope the OP learns from it.

 

Cheers Tharwat

 

 

 

 

Message 7 of 8
TCCS-Admin
in reply to: pbejse

Thank you so much,

   I really appreciate that.

 

Paul

Message 8 of 8
pbejse
in reply to: TCCS-Admin

Glad it works for you, it still need a lot of work though.

I'm pretty sure you can handle those  ACT-Standards

 

Cheers

 

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost