please help, Lisp localize objects with the same content!

please help, Lisp localize objects with the same content!

sorry for my bad English!

khoanh ve Engli.dwg

Something like this http://www.cadtutor.net/forum/showthread.php?91084-Area-Statement-Under-Layer-quot-Acquired-No.-amp-Area-quot-to-the-csv

no, All Text ONT => BOUNDARY, All Text CLN => BOUNDARY (or HATCH)

Kindly attach your drawing.

Thank you,

khoanh ve Engli.dwg

(defun c:test ()
 (vl-load-com)
 ;;-------------------=={ UnFormat String }==------------------;;
 ;;                                                            ;;
 ;;  Returns a string with all MText formatting codes removed. ;;
 ;;------------------------------------------------------------;;
 ;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
 ;;------------------------------------------------------------;;
 ;;  Arguments:                                                ;;
 ;;  str - String to Process                                   ;;
 ;;  mtx - MText Flag (T if string is for use in MText)        ;;
 ;;------------------------------------------------------------;;
 ;;  Returns:  String with formatting codes removed            ;;
 ;;------------------------------------------------------------;;
 (defun LM:UnFormat (str mtx / _replace rx)
   (defun _replace (new old str) (vlax-put-property rx 'pattern old) (vlax-invoke rx 'replace str new))
   (if	(setq rx (vlax-get-or-create-object "VBScript.RegExp"))
     (progn (setq str (vl-catch-all-apply
		 (function
		   (lambda ()
		     (vlax-put-property rx 'global actrue)
		     (vlax-put-property rx 'multiline actrue)
		     (vlax-put-property rx 'ignorecase acfalse)
		     (foreach pair '(("\032" . "\\\\\\\\")
				     (" " . "\\\\P|\\n|\\t")
				     ("$1" . "\\\\(\\\\[ACcFfHLlOopQTW])|\\\\[ACcFfHLlOopQTW][^\\\\;]*;|\\\\[ACcFfHLlOopQTW]")
				     ("$1$2/$3" . "([^\\\\])\\\\S([^;]*)[/#\\^]([^;]*);")
				     ("$1$2" . "\\\\(\\\\S)|[\\\\](})|}")
				     ("$1" . "[\\\\]({)|{")
				    )
		       (setq str (_replace (car pair) (cdr pair) str))
		     )
		     (if mtx
		       (_replace "\\\\" "\032" (_replace "\\$1$2$3" "(\\\\[ACcFfHLlOoPpQSTW])|({)|(})" str))
		       (_replace "\\" "\032" str)
		     )
		   )
		 )
	       )
     )
     (vlax-release-object rx)
     (if (null (vl-catch-all-error-p str))
       str
     )
     )
   )
 )
 ;; Unique  -  Lee Mac
 ;; Returns a list with duplicate elements removed.
 (defun LM:Unique (l / x r)
   (while l
     (setq x (car l)
    l (vl-remove x (cdr l))
    r (cons x r)
     )
   )
   (reverse r)
 )
 ;;
 ;;
 ;; Source : http://www.theswamp.org/index.php?topic=10371.0
				;Union polylines
				;Stefan M. 09.01.2014
 (defun UNIP (lst / *error* i lst r1 reg ss sysvar prop)
   (or acDoc (setq acDoc (vla-get-activedocument (vlax-get-acad-object))))
   (setq ms (vlax-get acDoc
	       (if (= 1 (getvar 'cvport))
		 'paperspace
		 'modelspace
	       )
     )
   )
   (vla-startundomark acDoc)
   (setq sysvar (mapcar 'getvar '(peditaccept draworderctl cmdecho)))
   (defun *error* (msg)
     (and msg (not (wcmatch (strcase msg) "*CANCEL*,*QUIT*,*EXIT*")) (princ (strcat "\nError: " msg)))
     (mapcar 'setvar '(peditaccept draworderctl cmdecho) sysvar)
     (vla-endundomark acDoc)
     (princ)
   )
   (foreach x lst (vla-put-closed x :vlax-true))
   (setq prop (mapcar '(lambda (p) (vlax-get (car lst) p)) '(Layer LineType Color)))
   (setq reg (vlax-invoke ms 'AddRegion lst))
   (foreach x lst
     (if (not (vlax-erased-p x))
(vla-delete x)
     )
   )
   (setq r1 (car reg))
   (foreach x (cdr reg) (vlax-invoke r1 'boolean acunion x))
   (mapcar '(lambda (p v) (vlax-put r1 p v)) '(Layer LineType Color) prop)
   (setq lst (apply 'append
	     (mapcar '(lambda (a)
			(if (listp a)
			  (mapcar 'vlax-vla-object->ename a)
			  (list (vlax-vla-object->ename a))
			)
		      )
		     (mapcar '(lambda (e / p)
				(if (eq (vla-get-objectname e) "AcDbRegion")
				  (progn (setq p (vlax-invoke e 'explode)) (vla-delete e) p)
				  e
				)
			      )
			     (vlax-invoke r1 'explode)
		     )
	     )
      )
   )
   (vla-delete r1)
   (setq ss (ssadd))
   (foreach x lst (ssadd x ss))
   (mapcar 'setvar '(peditaccept draworderctl cmdecho) '(1 0 0))
   (command "_pedit" "_m" ss "" "_j" "" "")
   (*error* nil)
   (princ)
 )
 ;;
 ;; ==========================
 ;; ACTUAL PROGRAM STARTS HERE
 ;; ==========================
 ;;
 (setvar "cmdecho" 0)
 (setq oldsnapmode (getvar "snapmode"))
 (setq oldosmode (getvar "osmode"))
 (setq oldlayer (getvar "clayer"))
 (setq oldorthomode (getvar "orthomode"))
 (setvar "snapmode" 0)
 (setvar "osmode" 0)
 (setvar "orthomode" 0)
 (setq sset (ssget "_:L" '((0 . "*TEXT"))))
 (setq textlist nil)
 (setq textstrlist nil)
 (repeat (setq n (sslength sset))
   (setq ent (ssname sset (setq n (1- n))))
   (setq obj (vlax-ename->vla-object ent))
   (setq txtstring (strcat (LM:UnFormat (vla-get-textstring obj) nil)))
   (setq textlist (cons (list ent txtstring) textlist))
   (setq textstrlist (cons txtstring textstrlist))
 )
 (setq uniqtextlist (LM:Unique textstrlist))
 (setq finallist nil)
 (foreach xx uniqtextlist
   (setq templist nil)
   (foreach yy	textlist
     (if (equal xx (cadr yy))
(progn (setq templist (cons (car yy) templist)))
     )
   )
   (setq finallist (cons (list xx templist) finallist))
 )
 (setq cnt 1)
 (foreach xx finallist
   (setq lyrname (strcat "LYR-" (car xx)))
   (if	(not (tblsearch "LAYER" lyrname))
     (command "_.-layer" "M" lyrname "C" cnt "" "L" "Continuous" "" "LW" 0.25 "" "")
   )
   (setq cnt (1+ cnt))
   (setq entlist (cadr xx))
   (setvar 'clayer lyrname)
   (setq joinlist nil)
   (foreach yy	entlist
     (setq obj (vlax-ename->vla-object yy))
     (setq inspt (vlax-safearray->list (vlax-variant-value (vla-get-textalignmentpoint obj))))
     (command "-boundary" inspt "")
     (setq joinlist (cons (vlax-ename->vla-object (entlast)) joinlist))
   )
   (UNIP joinlist)
 )
 (setvar "snapmode" oldsnapmode)
 (setvar "orthomode" oldorthomode)
 (setvar "osmode" oldosmode)
 (if (tblsearch "LAYER" oldlayer)
   (setvar "clayer" oldlayer)
 )
 (princ)
)

Run by typing TEST.

very good but boundary ONT?

When i run the routine, two boundaries get created, 1st for all ONT texts and 2nd for all CLN texts, as desired by you.

What is the problem in the routine ?

Thank you!

I want something like this:

2.dwg

Kindly check my modified code in Post #6.

Thanh you!

You check his help of Text BOUNDARY ONT

My program gives this output.

What is the problem in this ??

Thanh'k mailmaverick