Is it possible for get overlapping letters to excel data by bundle (one by one)?

May 30

Is it possible for combining different texts that overlapping?

For Example, "CCC" is on "BBB" and "BBB" is on "AAA".

After processing, the result is "AAABBBCCC"!

Thank you for reading~

Edited May 30 by SLW210
Deleted Links!!

May 30

Hi @GoldSA,

Please, try the following code:

(prompt "\nTo run a LISP type: COMTXT")
(princ)

(defun c:COMTXT ( / ent text_val text_val_ascii minPt maxPt ss len i new_txt output_txt sort_num n txt_val new_output_txt pt)
  
  (setq ent (car (entsel "\nSelect TEXT:"))
	text_val (cdr (assoc 1 (entget ent)))
	text_val_ascii (ascii (substr text_val 1 1))
	)
  
  (vla-GetBoundingBox (vlax-ename->vla-object ent) 'minPt 'maxPt)
  
  (setq minPt (vlax-safearray->list minPt)
	maxPt (vlax-safearray->list maxPt)
	)
  
  (setq ss (ssget "_F" (list minPt maxPt) (list (cons 0 "*TEXT"))))
  
  (if (ssmemb ent ss)
    (ssdel ent ss)
    )
  
  (setq len (sslength ss)
	i 0
	new_txt (list (list text_val))
	)
  
  (while (< i len)
    (setq txt_val (list (cdr (assoc 1 (entget (ssname ss i)))))
	  txt_val_ascii (ascii (substr (nth 0 txt_val) 1 1))
	  )
    (cond
      ((< txt_val_ascii text_val_ascii)
       (setq new_txt (append (list txt_val) new_txt))
       )
      
      ((> txt_val_ascii text_val_ascii)
       (setq new_txt (cons txt_val new_txt))
       )
      )
    (setq i (1+ i))
    )
  
  (setq output_txt (mapcar (function (lambda (x) (car x))) new_txt)
	sort_num (vl-sort-i output_txt '<)
	n 0
	)

  (repeat (length output_txt)
    (setq txt_val (nth (nth n sort_num) output_txt)
	  new_output_txt (append (list txt_val) new_output_txt)
	  n (1+ n)
	  )
    )

  (setq new_output_txt (reverse new_output_txt)
        output_txt (apply 'strcat new_output_txt)
	pt (getpoint "\nPick the point to insert a concatenated text:")
	)
  
  (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbText") (cons 10 pt) (cons 40 (cdr (assoc 40 (entget ent)))) (cons 1 output_txt) (cons 50 (cdr (assoc 50 (entget ent))))))
  (princ)
  )

When I use the code from above, I get this (picture 1). ** On the first input values "A B C", they overlap each other, but have a different insertation point for the text entity.

Best regards.

Edited May 30 by Saxlle

May 30

My effort...

Just Text...

;;; Combine different overlapping text alphabetically.
;;;
;;; https://www.cadtutor.net/forum/topic/98013-is-it-possible-for-combining-different-texts-that-overlapping/#findComment-671805
;;;
;;; By SLW210 (a.k.a. Steve Wilson)
;;;

(defun c:CombTxtABC ( / ss i ent txts sorted-text result-text base-point)

  ;; Get  string value
  (defun get-text-entity (ent)
    (cdr (assoc 1 (entget ent)))
  )

  ;; Get insertion point
  (defun get-ins-point (ent)
    (cdr (assoc 10 (entget ent)))
  )

  ;; Sort alphabetically
  (defun sort-by-text (a b)
    (if (equal (cadr a) (cadr b))
      nil
      (if (or (null (cadr a)) (null (cadr b)))
        (null (cadr a))
        (< (cadr a) (cadr b)) 
      )
    )
  )

  ;; Prompt user
  (setq ss (ssget '((0 . "TEXT")))) ; Only allow TEXT (not MTEXT)

  (if ss
    (progn
      (setq txts '())

      ;; Loop through
      (setq i 0)
      (while (< i (sslength ss))
        (setq ent (ssname ss i))
        (if (and ent (eq (cdr (assoc 0 (entget ent))) "TEXT"))
          (setq txts (cons (list (get-ins-point ent) (get-text-entity ent) ent) txts))
        )
        (setq i (1+ i))
      )

      ;; Sort by content
      (setq sorted-text (vl-sort txts 'sort-by-text))

      ;; Combine all
      (setq result-text "")
      (foreach text-item sorted-text
        (setq result-text (strcat result-text (cadr text-item)))
      )

      ;; Insertion point from first text
      (setq base-point (car (car sorted-text)))

      ;; Create new TEXT with combined string
      (entmake
        (list
          (cons 0 "TEXT")
          (cons 8 "0") ; Layer
          (cons 10 base-point)
          (cons 40 1.0) ; Height
          (cons 1 result-text)
          (cons 7 "Standard") ; Text style
          (cons 72 1) ; Center justified
          (cons 11 base-point)
        )
      )

      ;; Delete original text
      (foreach text-item sorted-text
        (if (and (listp text-item) (cdr (assoc 0 (entget (caddr text-item)))))
          (entdel (caddr text-item))
        )
      )

      (princ (strcat "\nCombined text: " result-text))
    )
    (princ "\nNo valid TEXT selected.")
  )
  (princ)
)

Text/MText...

;;; Combine different overlapping text/Mtext alphabetically.
;;;
;;; https://www.cadtutor.net/forum/topic/98013-is-it-possible-for-combining-different-texts-that-overlapping/#findComment-671805
;;;
;;; By SLW210 (a.k.a. Steve Wilson)
;;;

(defun c:CombTxt_MTxtABC ( / ss i ent txts sorted-text result-text base-point)

  ;; Get string value
  (defun get-text-entity (ent)
    (if (eq (cdr (assoc 0 (entget ent))) "MTEXT")
      (cdr (assoc 1 (entget ent))) ; For MTEXT
      (cdr (assoc 1 (entget ent))) ; For TEXT
    )
  )

  ;; Get insertion point
  (defun get-ins-point (ent)
    (cdr (assoc 10 (entget ent)))
  )

  ;; Sort alphabetically
  (defun sort-by-text (a b)
    (if (equal (cadr a) (cadr b))
      nil 
      (if (or (null (cadr a)) (null (cadr b)))
        (null (cadr a))
        (< (cadr a) (cadr b))
      )
    )
  )

  ;; Prompt user
  (setq ss (ssget '((0 . "TEXT,MTEXT")))) ; Allow both TEXT and MTEXT

  (if ss
    (progn
      (setq txts '())

      ;; Loop through
      (setq i 0)
      (while (< i (sslength ss))
        (setq ent (ssname ss i))
        (if (and ent (or (eq (cdr (assoc 0 (entget ent))) "TEXT")
                         (eq (cdr (assoc 0 (entget ent))) "MTEXT")))
          (setq txts (cons (list (get-ins-point ent) (get-text-entity ent) ent) txts))
        )
        (setq i (1+ i))
      )

      ;; Sort by content
      (setq sorted-text (vl-sort txts 'sort-by-text))

      ;; Combine all
      (setq result-text "")
      (foreach text-item sorted-text
        (setq result-text (strcat result-text (cadr text-item)))
      )

      ;; Insertion point from first text
      (setq base-point (car (car sorted-text)))

      ;; Create new text with combined string
      (entmake
        (list
          (cons 0 "TEXT")
          (cons 8 "0") ; Layer
          (cons 10 base-point)
          (cons 40 1.0) ; Height
          (cons 1 result-text)
          (cons 7 "Standard") ; Text style
          (cons 72 1) ; Center justified
          (cons 11 base-point)
        )
      )

      ;; Delete original
      (foreach text-item sorted-text
        (if (and (listp text-item) (cdr (assoc 0 (entget (caddr text-item)))))
          (entdel (caddr text-item))
        )
      )

      (princ (strcat "\nCombined (M)Text: " result-text))
    )
    (princ "\nNo valid Text or MText entities selected.")
  )
  (princ)
)

May 31

Wow, Thank you for your good making codes, Saxlle and SLW210.
It works well for my first content.
I appreciate and I was touched your quick replys and I feel your kindness and warm heart.

In addition to my first question, I want to get to excel data.

For example,

Input values(in cad)

(overlapping letters) (AAA 111 222) (BBB 333 444) (CCC 555 666) (DDD 777 888 999) .......

Output values(in excel)

AAA 111 222
BBB 333 444
CCC 555 666
DDD 777 888 999
.......

Thank you for reading.
Thank you, Cadtutor and Cadtutor Forum.
God bless all of you.

June 1

Have you started a new post based on one you already had ? No need for that.

June 1

Do you want to sort the entities by their display order (with the bottommost entity first and the topmost last)?

Or do you want to sort them alphabetically by text content?

June 1

I merged your threads into the original.

June 1

Do you mean like this in Excel or all in column A.

June 2

23 minutes ago, BIGAL said:

Do you mean like this in Excel or all in column A.

YES, YOU'RE RIGHT.

THIS IS CORRECT~ ^^

June 2

The example for my question.

It's very difficult question.

The sorting is not major point.

Output is one bundle by one bundle in excel sheet.
one bundle means overlapping letters.
Thank you for your concern.

Edited June 2 by GoldSA

June 2

What you show in the image is different to what people think you want. Need a sample dwg. The way to go may be look for the red text by layer and then is any other text touching. Join the 2 answers and post to Excel. The to Excel can be done directly.

Post sample dwg.

June 2

Please check the attached sample file.

Thank you for reading.

CADTUTOR.dwg

June 2

@GoldSA,

Try this code:

(prompt "\nTo run a LISP type: COMTXTCSV")
(princ)

(defun c:COMTXTCSV ( / old_snap ss len i lst file op minPt maxPt ssn lst elast ptlist)
  (setq old_osnap (getvar 'osmode))
  (setvar 'osmode 0)
  
  (prompt "\nSelect TEXT or MTEXT:")
  
  (setq ss (ssget (list (cons 0 "*TEXT") (cons 8 "?????") (cons 62 1)))
	len (sslength ss)
	i 0
	lst (list)
	)
  
  (setq file (getfiled "Choose file save destination" "" "csv" 1)
	op (open file "w")
	)
  
  (while (< i len)
    (vla-GetBoundingBox (vlax-ename->vla-object (ssname ss i)) 'minPt 'maxPt)
    (setq minPt (vlax-safearray->list minPt)
	  maxPt (vlax-safearray->list maxPt)
	  ssn (ssget "_F" (list minPt maxPt) (list (cons 0 "*TEXT") (cons -4 "<AND") (cons 8 "TEXT") (cons 62 4) (cons -4 "AND>")))
	  lst (cons (list (cdr (assoc 1 (entget (ssname ss i)))) (cdr (assoc 1 (entget (ssname ssn 0))))) lst)
	  )
    
    (if (= ssn nil)
      (progn
	(command-s "_RECTANG" minPt maxPt)
	(setq elast (entlast)
	      ptlist (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= (car x) 10))) (entget elast)))
	      ssn (ssget "_CP" ptlist (list (cons 0 "*TEXT") (cons -4 "<AND") (cons 8 "TEXT") (cons 62 4) (cons -4 "AND>")))
	      lst (cons (list (cdr (assoc 1 (entget (ssname ss i)))) (cdr (assoc 1 (entget (ssname ssn 0))))) lst)
	      )
	)
      )
    (setq i (1+ i))
    )
  
  (foreach val lst
    (write-line (strcat (car val) "," (cadr val)) op)
    )
  
  (close op)
  (setvar 'osmode old_osnap)
  (prompt (strcat "\nThe text values are written in " (vl-filename-base file) ".csv!"))
  (princ)
  )

Two things to note:

- the firtst one is inside this part of code "(setq ss (ssget (list (cons 0 "*TEXT") (cons 8 "?????") (cons 62 1)))", (cons 8 "?????")", the question marks present the red text values (I can't read the layer name, it is on chineese, but doesn't make a problem for me to performe COMTXTCSV) (picture 1). If the layer name is differnt, you need to put a right name for the layer name inside (cons 8 "?????"), which is the inside "(setq ss (ssget (list (cons 0 "*TEXT") (cons 8 "?????") (cons 62 1)))"".

- the second one is inside this part of code "ssn (ssget "_F" (list minPt maxPt) (list (cons 0 "*TEXT") (cons -4 "<AND") (cons 8 "TEXT") (cons 62 4) (cons -4 "AND>")))" and this part of code "ssn (ssget "_CP" ptlist (list (cons 0 "*TEXT") (cons -4 "<AND") (cons 8 "TEXT") (cons 62 4) (cons -4 "AND>")))", if the layer name is different than "TEXT" inside the "(cons 8 "TEXT")", you need to replace into the correct layer name, and for the "TEXT COLOR" inside the "(cons 62 4)", you also need to replace into the correct color index (picture 2).

After executing the COMTXTCSV command, I get this (picture 3):

Best regards.

Edited June 2 by Saxlle

June 2

Thank you very much ^^

It works well in file I attached.

But I use a few color for Number and Name about building design.

This file is an architectural floor plan, so it has many duplicate words.

And I attached whole file, I'm sorry for bothering you so much.

CADTUTOR_250603.dwg

I think this LISP is very difficult, but it's easy for cadtutor.

Thank you very much for your interest and reading.

June 3

like this?doit.xlsx

June 3

I used python and a KDTree to pair up the texts

There was challenge over at the swamp pairing a line with text

https://www.theswamp.org/index.php?topic=59487.0

Could be a source of inspiration for pairing up text items.

The fastest is using a language with a KDTree, for lisp, Lee Mac’s code was pretty impressive

https://www.theswamp.org/index.php?topic=59487.msg620760#msg620760

June 3

@GoldSA

Try this modified code:

(prompt "\nTo run a LISP type: COMTXTCSV")
(princ)

(defun c:COMTXTCSV ( / old_snap ss len i lst file op minPt maxPt ssn lst elast ptlist)
  (setq old_osnap (getvar 'osmode))
  (setvar 'osmode 0)
  
  (prompt "\nSelect TEXT or MTEXT:")
  
  (setq ss (ssget (list (cons 0 "*TEXT") (cons 8 "?????"))) ;; (cons 62 1)
	len (sslength ss)
	i 0
	lst (list)
	)
  
  (setq file (getfiled "Choose file save destination" "" "csv" 1)
	op (open file "w")
	)
  
  (while (< i len)
    (vla-GetBoundingBox (vlax-ename->vla-object (ssname ss i)) 'minPt 'maxPt)
    (setq minPt (vlax-safearray->list minPt)
	  maxPt (vlax-safearray->list maxPt)
	  ssn (ssget "_F" (list minPt maxPt) (list (cons 0 "*TEXT") (cons 8 "TEXT"))) ;; (cons 62 4)
	  )
    
    (if (/= ssn nil)
      (setq lst (cons (list (cdr (assoc 1 (entget (ssname ss i)))) (cdr (assoc 1 (entget (ssname ssn 0))))) lst))
      
      (progn
	(command-s "_RECTANG" minPt maxPt)
	(setq elast (entlast)
	      ptlist (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= (car x) 10))) (entget elast)))
	      ssn (ssget "_CP" ptlist (list (cons 0 "*TEXT") (cons 8 "TEXT"))) ;; (cons 62 4)
	      )
	(if (/= ssn nil)
	  (setq lst (cons (list (cdr (assoc 1 (entget (ssname ss i)))) (cdr (assoc 1 (entget (ssname ssn 0))))) lst))
	  )
	)
      )
    (setq i (1+ i))
    )
  
  (foreach val lst
    (write-line (strcat (car val) "," (cadr val)) op)
    )
  
  (close op)
  (setvar 'osmode old_osnap)
  (prompt (strcat "\nThe text values are written in " (vl-filename-base file) ".csv!"))
  (princ)
  )

After executing the modified code, I get this (chinees letters transformed into to the unicod chars, doesn't going to be problem for you):

Best regards.

June 3

It is the same as doit.xlsx file which are posted by @Danielm103, but with chinees letters.

June 3

2 minutes ago, Saxlle said:

but with chinees letters.

Korean, I know because I watch kpop

June 3

Thank you for correction Sorry @GoldSA. Hm, the third season of the squid game will burn

Sign In

Is it possible for get overlapping letters to excel data by bundle (one by one)?

Recommended Posts

GoldSA

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

BIGAL

Saxlle

Danielm103

Posted Images

Saxlle

SLW210

GoldSA

BIGAL

XDSoft

SLW210

BIGAL

GoldSA

GoldSA

BIGAL

GoldSA

Saxlle

GoldSA

Danielm103

Danielm103

Saxlle

Saxlle

Danielm103

Saxlle

Join the conversation

BIGAL

Saxlle

Danielm103

Tutorials

Forums

Activity