Merge Text to Clear Text

[Raje]

hi,

 

i how remove lesser values text from merge text?

i need separate the text from merging and remove lesser values and retain maximum values only. one of the my group text is 489,1200,356. so delete 489, 356 and retain 1200 only.

 

Thanks in Advance..

Merging text to Clear text.dwg

[BIGAL]

Try this

 

; thanks to www.Lee-mac.com for the following defuns  who has helped immensly
;csv -> list by Lee-mac
(defun _csv->lst ( str / pos )
(if (setq pos (vl-string-position 44 str))
(cons (substr str 1 pos) (_csv->lst (substr str (+ pos 2))))
(list str)
)
)

(setq ans "489,1200,356")
(setq mylist (_csv->lst  ans))

(setq biggest (apply 'max (mapcar 'atof mylist)))
(setq smallest (apply 'min (mapcar 'atof mylist)))

[Raje]

what is the command that? to use your code?

[devitg]

; thanks to [url]www.Lee-mac.com[/url] for the following defuns  who has helped immensly
;csv -> list by Lee-mac
(defun _csv->lst ( str / pos )
(if (setq pos (vl-string-position 44 str))
(cons (substr str 1 pos) (_csv->lst (substr str (+ pos 2))))
(list str)
)
)




(defun c:max-min ()
(setq ans "489,1200,356");; fill it with your csv's  
(setq mylist (_csv->lst  ans))
(alert (strcat "the biggest is ..." (rtos  (setq biggest (apply 'max (mapcar 'atof mylist))) 2 4 )))
(setq smallest (apply 'min (mapcar 'atof mylist)))
(alert (strcat "the smallest is ..." (rtos  (setq  smallest (apply 'min (mapcar 'atof mylist))) 2 4 )))

)  

 

 

MAX-MIN is the command

Edited October 31, 2017 by SLW210
Use CODE Tags not QUOTE Tags

[Raje]

dear devitg,

after command using there is showing one pop message showing for maximum value from selected text.

but i need overlapping text to individual texts from each group of overlapping texts. so erase lowest value texts from each group and retain maximum value from each group.

 

please refer my sample drawing for before code applying to after code applying.

 

Thankyou..

[devitg]

Hi , as I can not see the TRUE WHOLE DGW, I ask , could it be each text group inside a polyline?

could it be as it.dwg

[Raje]

Hi , as I can not see the TRUE WHOLE DGW, I ask , could it be each text group inside a polyline?

 

Yes Dev.

I put rectangles for reference purpose only. my text groups are each over lap texts. and individual texts you can leave. i want extract from overlap texts maximum value.

 

Thank you...

[BIGAL]

Try this no checking for text matching or smarter handling of numbers.

 

(defun c:max-min ( / ss mylist obj biggest smallest inspt)
(alert "Press <Cr> to exit loop")
(while (setq ss (ssget (list (cons 0 "Text"))))
(setq mylist '())
(repeat (setq x (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1)))))
(setq mylist (cons (vla-get-textstring obj) mylist))
(setq inspt (vlax-safearray->list (vlax-variant-value (vla-get-insertionpoint obj))))
)
(setq biggest (rtos (apply 'max (mapcar 'atof mylist))2 3))
(setq smallest (rtos (apply 'min (mapcar 'atof mylist))2 3))
;(alert (strcat "The biggest is ... " biggest "\n\nThe smallest is ... " smallest))
(command "Text"(getpoint "pick text point") "" "" biggest)
)
)

Edited October 30, 2017 by BIGAL
Erase removed

[devitg]

Bigal, nice solution

[Raje]

Bigal, nice solution

Dear Bigal thank you,

but your code erasing remaining text. i need every overlapping text group texts.

 

like: from one overlaping text group is 1200,489,356 to 356. anther group is 256,257 to 257; 900,150,355 to 900 etc... respectively.

 

i am attached updated format drawing. please have a look.,

 

Thankyou..

[Raje]

i am attached updated format drawing. please have a look.,

Merging text to Clear text2.dwg

[BIGAL]

Code changed no erase.

[Raje]

Dear BIGAL Thank you.

working but code asks multiple time to select. can you change as select all texts and paste by single click or single attempt? because drawing contains large number of overlaping text.

need by single shot.

 

Thank you again..

[devitg]

There is no attached updated DWG

[Raje]

There is no attached updated DWG

 

hi,

i am attached at #11 post.

 

thank you...

[devitg]

I´m sure that if you show us the whole dwg , it will be away to do in one touch.

 

As you show us , is almost impossible.

 

The lisp as to iterate all text, find the overlapped group by the "textbox" mean the virtual box that enclose each text , see what boxes overlap and make the sort and erase the rest for each group.

[Roy_043]

Try:

(vl-load-com)

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
 (if ss
   (repeat (setq i (sslength ss))
     (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
   )
 )
)

(defun KGA_Geom_BoundingboxTouch_P (box1 box2 fuzz)
 (vl-every
   '(lambda (coordBox1BL coordBox1TR coordBox2BL coordBox2TR)
     (and
       (<= coordBox1BL (+ coordBox2TR fuzz))
       (<= coordBox2BL (+ coordBox1TR fuzz))
     )
   )
   (car box1)
   (cadr box1)
   (car box2)
   (cadr box2)
 )
)

(defun KGA_Geom_ObjectBoundingbox (obj / ptBL ptTR)
 (vla-getboundingbox obj 'ptBL 'ptTR)
 (list (vlax-safearray->list ptBL) (vlax-safearray->list ptTR))
)


(defun ObjectListGroupByBox (lst / N_Fnd fnd grp ret)

 (defun N_Fnd (lst grp / fndP)
   (setq lst
     (mapcar
       '(lambda (subLst)
         (if
           (vl-some
             '(lambda (subGrp)
               (KGA_Geom_BoundingboxTouch_P (car subLst) (car subGrp) 1e-
             )
             grp
           )
           (progn
             (setq fndP T)
             (setq grp (cons subLst grp))
             nil
           )
           subLst
         )
       )
       lst
     )
   )
   (if fndP (list (vl-remove nil lst) grp))
 )

 (setq lst
   (mapcar
     '(lambda (obj) (list (KGA_Geom_ObjectBoundingbox obj) obj))
     lst
   )
 )
 (while lst
   (setq grp (list (car lst)))
   (if (setq lst (cdr lst))
     (while (setq fnd (N_Fnd lst grp))
       (setq lst (car fnd))
       (setq grp (cadr fnd))
     )
   )
   (setq ret (cons (mapcar 'cadr grp) ret))
 )
 ret
)

(defun c:CleanText ( / N_Clean doc)

 (defun N_Clean (grp / tmp val valObj)
   (foreach obj grp
     (if (>= val (setq tmp (read (vla-get-textstring obj))))
       (vla-delete obj)
       (progn
         (if valObj (vla-delete valObj))
         (setq valObj obj)
         (setq val tmp)
       )
     )
   )
 )

 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (foreach grp (ObjectListGroupByBox (KGA_Conv_Pickset_To_ObjectList (ssget '((0 . "TEXT,MTEXT"))))) ; select text and mtext entities.
   (N_Clean grp)
 )
 (vla-endundomark doc)
 (princ)
)

[Raje]

Its Amazing ROYY....

i just troubled with underlined text only. if i select underlined text, showing error. please consider underlined text too.

please check this drawing..

 

Thankyouuu..

Under lined text.dwg

[Roy_043]

Right. Plus there is a bigger problem with my code in post #17: non-integer texts should be filtered out as well.

 

Improved code:

(vl-load-com)

(defun KGA_Conv_Pickset_To_ObjectList (ss / i ret)
 (if ss
   (repeat (setq i (sslength ss))
     (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret))
   )
 )
)

(defun KGA_Geom_BoundingboxTouch_P (box1 box2 fuzz)
 (vl-every
   '(lambda (coordBox1BL coordBox1TR coordBox2BL coordBox2TR)
     (and
       (<= coordBox1BL (+ coordBox2TR fuzz))
       (<= coordBox2BL (+ coordBox1TR fuzz))
     )
   )
   (car box1)
   (cadr box1)
   (car box2)
   (cadr box2)
 )
)

(defun KGA_Geom_ObjectBoundingbox (obj / ptBL ptTR)
 (vla-getboundingbox obj 'ptBL 'ptTR)
 (list (vlax-safearray->list ptBL) (vlax-safearray->list ptTR))
)


(defun ObjectListGroupByBox (lst / N_Fnd fnd grp ret)

 (defun N_Fnd (lst grp / fndP)
   (setq lst
     (mapcar
       '(lambda (subLst)
         (if
           (vl-some
             '(lambda (subGrp)
               (KGA_Geom_BoundingboxTouch_P (car subLst) (car subGrp) 1e-
             )
             grp
           )
           (progn
             (setq fndP T)
             (setq grp (cons subLst grp))
             nil
           )
           subLst
         )
       )
       lst
     )
   )
   (if fndP (list (vl-remove nil lst) grp))
 )

 (setq lst
   (mapcar
     '(lambda (obj) (list (KGA_Geom_ObjectBoundingbox obj) obj))
     lst
   )
 )
 (while lst
   (setq grp (list (car lst)))
   (if (setq lst (cdr lst))
     (while (setq fnd (N_Fnd lst grp))
       (setq lst (car fnd))
       (setq grp (cadr fnd))
     )
   )
   (setq ret (cons (mapcar 'cadr grp) ret))
 )
 ret
)

(defun c:CleanText ( / N_Clean doc)

 (defun N_Clean (grp / tmp val valObj)
   (foreach obj grp
     (if (>= val (setq tmp (atoi (vl-string-left-trim "%OU" (vla-get-textstring obj)))))
       (vla-delete obj)
       (progn
         (if valObj (vla-delete valObj))
         (setq valObj obj)
         (setq val tmp)
       )
     )
   )
 )

 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-endundomark doc)
 (vla-startundomark doc)
 (foreach
   grp
   (ObjectListGroupByBox
     (KGA_Conv_Pickset_To_ObjectList
       (ssget                               ; Filter can only handle limited text formatting.
         '(
           (0 . "TEXT")
           (1 . "~*[~0-9%OU]*")
           (-4 . "<OR")
             (-4 . "<AND")
               (1 . "#*")
               (1 . "~?*[~0-9]*")
             (-4 . "AND>")
             (-4 . "<AND")
               (1 . "%%[OU]#*")
               (1 . "~???*[%OU]*")
             (-4 . "AND>")
             (-4 . "<AND")
               (1 . "%%[OU]%%[OU]#*")
               (1 . "~??????*[%OU]*")
             (-4 . "AND>")
           (-4 . "OR>")
         )
       )
     )
   )
   (N_Clean grp)
 )
 (vla-endundomark doc)
 (princ)
)

Edited October 30, 2017 by Roy_043
Improved wcmatch statements.

[ronjonp]

Not winning any speed tests , but here's another one:

(defun c:foo (/ a l s s2 tmp)
 (defun _foo (str / i tmp)
   (setq i (vl-string->list ".0123456789"))
   (if	(setq tmp (vl-remove-if-not '(lambda (x) (vl-position x i)) (vl-string->list str)))
     (atof (apply 'strcat (mapcar 'chr tmp)))
   )
 )
 (if (setq s (ssget ":L" '((0 . "text"))))
   (progn
     (foreach x (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
(if (setq tmp (_foo (vla-get-textstring x)))
  (setq s2 (cons (cons tmp x) s2))
)
     )
     (setq s (vl-sort s2 (function (lambda (a b) (> (car a) (car b))))))
     (while (setq a (car s))
(if (setq
      l	(vl-remove-if-not
	  (function (lambda (x) (vlax-invoke (cdr a) 'intersectwith (cdr x) acextendnone)))
	  (setq s (cdr s))
	)
    )
  (progn (while	(setq tmp
		       (vl-some
			 (function
			   (lambda (x)
			     (vl-remove-if-not
			       (function
				 (lambda (y) (vlax-invoke (cdr y) 'intersectwith (cdr x) acextendnone))
			       )
			       (vl-remove-if (function (lambda (z) (vl-position z l))) s)
			     )
			   )
			 )
			 l
		       )
		)
	   (setq l (cons (car tmp) l))
	 )
	 (mapcar (function (lambda (x) (setq s (vl-remove x s)) (vla-delete (cdr x)))) l)
	 (vla-put-color (cdr a) 1)
	 (vla-update (cdr a))
  )
)
     )
   )
 )
 (princ)
)
(vl-load-com)

Edited November 1, 2017 by ronjonp