Count of words of an attribute in different blocks with LISP

[Anonymous]

Hello, I am new to routine programming with Lisp and I don't have much idea of ​​automating the following process:

In a drawing, there are different blocks within a layer called "STRUCTURES", with an attribute called "STRUCPY". Inside that attribute there are different codes separated by commas "," that refer to different elements.

" (619,6XAL,752-N1) ".

The routine must count the number of total elements found in the different blocks.

For example, in my drawing there are three blocks with the following attributes:

BLOCK 1= (619,6XAL,752-N1)

BLOCK 2= (619,752-N1,SPT-023,SPT-023M)

BLOCK 3= (619,752-N1,SPT-023)

The program must print the number of total elements found in the different blocks, so in this case it would print the following:

619= 3

6XAL= 1

752-N1= 3

SPT-023 = 2

SPT-023M = 1

Currently I have a routine that manages to extract the attributes of the different blocks, but now I need to count each of those elements that are in the different blocks. I would be very grateful if anyone can give me some idea how to accomplish that process.

This is the routine to extract the attributes:

(defun c:EC ()

(if (setq ss1 (ssget "_X" '((0 . "insert") (8 . "STRUCTURES"))))
  (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
     (foreach AcDbAttrib (vlax-invoke (vlax-ename->vla-object ename) 'getattributes)
       (terpri)
       (princ (vla-get-textstring AcDbAttrib))
      ); foreach
      (princ "\n------------")
  ); foreach
); if

(princ)

);defun

Thanks in advance.

[ronjonp]

Try this ... added Lee's string parser.

(defun c:ec (/ lm:str->lst b r s)
  ;; String to List  -  Lee Mac
  ;; Separates a string using a given delimiter
  ;; str - [str] String to process
  ;; del - [str] Delimiter by which to separate the string
  ;; Returns: [lst] List of strings
  (defun lm:str->lst (str del / pos)
    (if	(setq pos (vl-string-search del str))
      (cons (substr str 1 pos) (lm:str->lst (substr str (+ pos 1 (strlen del))) del))
      (list str)
    )
  )
  (if (setq s (ssget "_X" '((0 . "insert") (8 . "STRUCTURES") (66 . 1))))
    (progn (foreach ename (mapcar 'cadr (ssnamex s))
	     (foreach att (vlax-invoke (vlax-ename->vla-object ename) 'getattributes)
	       (foreach	s (lm:str->lst (vla-get-textstring att) ",")
		 (if (setq b (assoc s r))
		   (setq r (subst (list s (1+ (cadr b))) b r))
		   (setq r (cons (list s 1) r))
		 )
	       )
	     )
	   )
	   (foreach x r (princ (strcat "\n" (car x) " = " (itoa (cadr x)))))
    )
  )
  (princ)
)

[Anonymous]

Oh no, It does not work.
It is not doing the individual count of each element.
This is what it prints

[ronjonp]

Maybe this?

(defun c:ec (/ lm:str->lst b r s)
  ;; String to List  -  Lee Mac
  ;; Separates a string using a given delimiter
  ;; str - [str] String to process
  ;; del - [str] Delimiter by which to separate the string
  ;; Returns: [lst] List of strings
  (defun lm:str->lst (str del / pos)
    (if	(setq pos (vl-string-search del str))
      (cons (substr str 1 pos) (lm:str->lst (substr str (+ pos 1 (strlen del))) del))
      (list str)
    )
  )
  (if (setq s (ssget "_X" '((0 . "insert") (66 . 1))))
    (progn
      (foreach ename (mapcar 'cadr (ssnamex s))
	(foreach att (vlax-invoke (vlax-ename->vla-object ename) 'getattributes)
	  (foreach s
		   (lm:str->lst
		     (vl-string-left-trim "(" (vl-string-right-trim ")" (vla-get-textstring att)))
		     ","
		   )
	    (if	(setq b (assoc s r))
	      (setq r (subst (list s (1+ (cadr b))) b r))
	      (setq r (cons (list s 1) r))
	    )
	  )
	)
      )
      (foreach x r (princ (strcat "\n" (car x) " = " (itoa (cadr x)))))
    )
  )
  (princ)
)

[Anonymous]

Raises an error, which says
"error: too few arguments."

I will attach a dwg file where are the blocks created.

Thank you for your collaboration.

[ronjonp]

You might copy the code again .. works here although some of the text has a leading space that will bork the numbers.

[ronjonp]

Try this .. it will remove leading and trailing spaces so the numbers should be correct:

(defun c:ec (/ _format lm:str->lst b r s)
  ;; String to List  -  Lee Mac
  ;; Separates a string using a given delimiter
  ;; str - [str] String to process
  ;; del - [str] Delimiter by which to separate the string
  ;; Returns: [lst] List of strings
  (defun lm:str->lst (str del / pos)
    (if	(setq pos (vl-string-search del str))
      (cons (substr str 1 pos) (lm:str->lst (substr str (+ pos 1 (strlen del))) del))
      (list str)
    )
  )
  (defun _format (s)
    (vl-string-left-trim
      "("
      (vl-string-right-trim ")" (vl-string-left-trim " " (vl-string-right-trim " " s)))
    )
  )
  (if (setq s (ssget "_X" '((0 . "insert") (66 . 1))))
    (progn (foreach ename (mapcar 'cadr (ssnamex s))
	     (foreach att (vlax-invoke (vlax-ename->vla-object ename) 'getattributes)
	       (foreach	s (lm:str->lst (_format (vla-get-textstring att)) ",")
		 (if (setq b (assoc s r))
		   (setq r (subst (list s (1+ (cadr b))) b r))
		   (setq r (cons (list s 1) r))
		 )
	       )
	     )
	   )
	   (foreach x r (princ (strcat "\n" (car x) " = " (itoa (cadr x)))))
    )
  )
  (princ)
)

Command: EC
6XAL = 1
= 18
SPT-023M = 1
SPT-023 = 2
752-N1 = 3
619 = 3

[Anonymous]

ooh wow yeah, you're right, it works, even though it's printing the number 18, I don't know what that number refers to. it's about to become a perfect code if you delete that number. It will be clean and I will be immensely grateful.

[ronjonp · Accepted solution]

---

@Anonymous wrote:
ooh wow yeah, you're right, it works, even though it's printing the number 18, I don't know what that number refers to. it's about to become a perfect code if you delete that number. It will be clean and I will be immensely grateful.

---

Easy enough ... that 18 is a count of blank attributes.

(defun c:ec (/ _format lm:str->lst a b r s)
  ;; String to List  -  Lee Mac
  ;; Separates a string using a given delimiter
  ;; str - [str] String to process
  ;; del - [str] Delimiter by which to separate the string
  ;; Returns: [lst] List of strings
  (defun lm:str->lst (str del / pos)
    (if	(setq pos (vl-string-search del str))
      (cons (substr str 1 pos) (lm:str->lst (substr str (+ pos 1 (strlen del))) del))
      (list str)
    )
  )
  (defun _format (s)
    (vl-string-left-trim
      "("
      (vl-string-right-trim ")" (vl-string-left-trim " " (vl-string-right-trim " " s)))
    )
  )
  (if (setq s (ssget "_X" '((0 . "insert") (66 . 1))))
    (progn (foreach ename (mapcar 'cadr (ssnamex s))
	     (foreach att (vlax-invoke (vlax-ename->vla-object ename) 'getattributes)
	       (if (wcmatch (setq a (vla-get-textstring att)) "*(*)*")
		 (foreach s (lm:str->lst (_format a) ",")
		   (if (setq b (assoc s r))
		     (setq r (subst (list s (1+ (cadr b))) b r))
		     (setq r (cons (list s 1) r))
		   )
		 )
	       )
	     )
	   )
	   (foreach x r (princ (strcat "\n" (car x) " = " (itoa (cadr x)))))
    )
  )
  (princ)
)

6XAL = 1
SPT-023M = 1
SPT-023 = 2
752-N1 = 3
619 = 3

[Anonymous]

woww, thank you so so so much, you have automated a very valuable process for me. you are a genious.
Good job!!!!!!!!!!.
Eventually I will need to extract that data to an excel table. but so far you have done an excellent job!!!!.
Thank youuuuuuuuu!!!!!

[Lee_Mac]

@ronjonp FWIW, this:

  (defun _format (s)
    (vl-string-left-trim
      "("
      (vl-string-right-trim ")" (vl-string-left-trim " " (vl-string-right-trim " " s)))
    )
  )

Could be equivalently written:

(defun _format ( s ) (vl-string-trim " ()" s))

Since the arguments for the string-trim functions are character sets rather than literal strings.

Good solution btw 👍

[ronjonp]

@Lee_Mac  Thanks .. knew there was a better way but the brain did not get to that solution today 🙂

[Anonymous]

@Lee_Mac @ronjonp Thank you so so mcuh for embodying your knowledge and intelligence in these codes, you guys are heroes to many people.

[ronjonp]

---

@Anonymous wrote:
woww, thank you so so so much, you have automated a very valuable process for me. you are a genious.
Good job!!!!!!!!!!.
Eventually I will need to extract that data to an excel table. but so far you have done an excellent job!!!!.
Thank youuuuuuuuu!!!!!

---

Glad to help 🍻

[Anonymous]

@ronjonp Hello!!!! 🙂 I have had a problem with the sign "\P" when the routine counts
the elements found in the attributes.

For example, in my drawing there are three blocks with the following attributes:



BLOCK 1 = (619,6XAL, 752-N1)

BLOCK 2 = (619,752-N1, SPT-023, \PSPT-023)

BLOCK 3 = (619,752-N1, SPT-023)

so the routine shows this:



6XAL = 1
\PSPT-023 = 1
SPT-023 = 2
752-N1 = 3
619 = 3



The "\P" makes my elements look different when they are actually the same elements.
Could this problem be solved and the routine omit the "\P" sign and identify that they are the same elements?



Then, it should print the following:



6XAL = 1
SPT-023 = 3
752-N1 = 3
619 = 3



I would be very grateful if you could help me with this.

Thank you very much in advance.

[ronjonp]

Get Lee's unformat string code from HERE.

Then replace the '_format' subfunction with this:

(defun _format (s) (lm:unformat (vl-string-trim " ()" s) nil))

[ronjonp]

Interesting enough if the string is pulled from DXF code 1 the mtext formatting is not included (AutoCAD 2021). If you have super long strings the rest of the text is stored in 3 codes so this may not be applicable, but give it a try:

(defun c:ec (/ _format a b r s)
  ;; Function tailored to sample drawing ( ie no spaces in data )
  (defun _format (s) (mapcar 'vl-princ-to-string (read (vl-string-translate "," " " s))))
  (if (setq s (ssget "_X" '((0 . "insert") (66 . 1))))
    (progn (foreach e (mapcar 'cadr (ssnamex s))
	     (foreach att (vlax-invoke (vlax-ename->vla-object e) 'getattributes)
	       (if (wcmatch (setq a (cdr (assoc 1 (entget (vlax-vla-object->ename att))))) "*(*)*")
		 (foreach s (_format a)
		   (if (setq b (assoc s r))
		     (setq r (subst (list s (1+ (cadr b))) b r))
		     (setq r (cons (list s 1) r))
		   )
		 )
	       )
	     )
	   )
	   (foreach x r (princ (strcat "\n" (car x) " = " (itoa (cadr x)))))
    )
  )
  (princ)
)

[Anonymous]

Yes, it does the count, but when I try to modify the blocks (pressing the ENTER key to an attribute of a block or introducing another element) it does not update the printout.

[ronjonp]

---

@Anonymous wrote:
Yes, it does the count, but when I try to modify the blocks (pressing the ENTER key to an attribute of a block or introducing another element) it does not update the printout.

---

Yeah .. I did not drill down far enough in the data. Use my previous recommendation to incorporate Lee's unformat function.

[Anonymous]

@ronjonp Thanks for your collaboration friend,you have helped me a lot.
I have zero knowledge of programming in LISP,
so I will not have enough knowledge to make the code work.

On the other hand, you would know that I must modify so that it only extract the attributes found in the ESTRUCTPY tag and not information found in ALTITUD or NO_ESTRUCT

(defun c:EC ()

(if (setq ss1 (ssget "_X" '((0 . "insert") (8 . "STRUCTURES"))))
  (foreach ename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss1)))
     (foreach AcDbAttrib (vlax-invoke (vlax-ename->vla-object ename) 'getattributes)
       (terpri)
       (princ (vla-get-textstring AcDbAttrib))
      ); foreach
      (princ "\n------------")
  ); foreach
); if

(princ)

);defun