Lisp code add

[k005]

Hello everyone

Can we add non-block expressions such as SZxxx (xx/xx) and Pxxx (xxx/xxx) to this code written by our @3wood friend?

;;; TAFT.lsp by 3wood
;;; Calculate total area from text in select blocks. Texts need in a format of "SZ01 (30/60)".
;;; https://forums.autodesk.com/t5/net/block-calculation/m-p/10798183#M71113

(defun C:KolonBetonu (/ b1 i1 p1 p2 p3 p4
	       RESULT s1 t1 KolonH )
  (prompt "Kolon apl. Bloklu yazılardan Hacim hesaplar (m²)* kolon yüks. ör : SZ01 (30/60)")
  (setq KolonH (getreal "\nKolon Yüksekliğini Giriniz (m) : "))
  (setq s1 (ssget '((0 . "INSERT")))
	RESULT 0.0)
  (repeat (setq i1 (sslength s1))
    (setq i1 (1- i1))
    (vlax-for b1 (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vla-get-name (vlax-ename->vla-object (ssname s1 i1))))
      (if (and (equal (vla-get-ObjectName b1) "AcDbText")
	       (setq t1 (vla-get-textstring b1)
		     p1 (vl-string-search "(" t1)
		     p2 (vl-string-search "/" t1)
		     p3 (vl-string-search ")" t1))
	       )
	(setq RESULT (+ RESULT  (* (* (atof (substr t1 (+ p1 2) (- p2 p1 1))) (atof (substr t1 (+ p2 2) (- p3 p2 1)))) 0.0001)))
	)
      )
    )
  
  (setq P4 (getpoint "\nYazının Yeri <+>"))
  ;(vl-cmdf "text" P4 "0.39" "0.0" (strcat "Kolon Betonu= "(rtos RESULT 2 2)" m\U+00B2 x  15 = " (rtos (* RESULT  KolonH) 2 2) " m\U+00B3"))
  (vl-cmdf "text" P4 "0.39" "0.0" (strcat "Kolon Betonu Miktarı : "(rtos RESULT 2 2)" x "  (rtos KolonH 2 2) " = " (rtos (* RESULT  KolonH) 2 2) " m\U+00B3"))
  )

[3wood]

Can you upload an example drawing showing 'before' and 'after'?

[k005]

the file is attached. clearly... Thank you @3wood 

[ronjonp · Accepted solution]

Try this modification:

;;; TAFT.lsp by 3wood
;;; Calculate total area from text in select blocks. Texts need in a format of "SZ01 (30/60)".
;;; https://forums.autodesk.com/t5/net/block-calculation/m-p/10798183#M71113

(defun c:kolonbetonu (/ i1 kolonh o p1 p2 p3 p4 result s1 t1)
  (prompt "Kolon apl. Bloklu yazilardan Hacim hesaplar (m²)* kolon yüks. ör : SZ01 (30/60)")
  (if (and (setq kolonh (getreal "\nKolon Yüksekligini Giriniz (m) : "))
	   (setq s1 (ssget '((0 . "INSERT,TEXT"))))
	   (setq result 0.0)
      )
    (progn
      (repeat (setq i1 (sslength s1))
	(setq i1 (1- i1))
	;; RJP » 2022-10-12 added TEXT objects and a bit more error checking on inputs
	(if (= "AcDbText" (vla-get-objectname (setq o (vlax-ename->vla-object (ssname s1 i1)))))
	  (if (and (setq t1 (vla-get-textstring o))
		   (setq p1 (vl-string-search "(" t1))
		   (setq p2 (vl-string-search "/" t1))
		   (setq p3 (vl-string-search ")" t1))
	      )
	    (setq result (+ result
			    (* (* (atof (substr t1 (+ p1 2) (- p2 p1 1)))
				  (atof (substr t1 (+ p2 2) (- p3 p2 1)))
			       )
			       0.0001
			    )
			 )
	    )
	  )
	  (vlax-for b1 (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object)))
				 (vla-get-name o)
		       )
	    (if	(and (equal (vla-get-objectname b1) "AcDbText")
		     (setq t1 (vla-get-textstring b1))
		     (setq p1 (vl-string-search "(" t1))
		     (setq p2 (vl-string-search "/" t1))
		     (setq p3 (vl-string-search ")" t1))
		)
	      (setq result (+ result
			      (* (* (atof (substr t1 (+ p1 2) (- p2 p1 1)))
				    (atof (substr t1 (+ p2 2) (- p3 p2 1)))
				 )
				 0.0001
			      )
			   )
	      )
	    )
	  )
	)
      )
      (if (setq p4 (getpoint "\nYazinin Yeri <+>"))
	;; (vl-cmdf "text" P4 "0.39" "0.0" (strcat "Kolon Betonu= "(rtos RESULT 2 2)" m\U+00B2 x  15 = " (rtos (* RESULT  KolonH) 2 2) " m\U+00B3"))
	(vl-cmdf "text"
		 p4
		 "0.39"
		 "0.0"
		 (strcat "Kolon Betonu Miktari : "
			 (rtos result 2 2)
			 " x "
			 (rtos kolonh 2 2)
			 " = "
			 (rtos (* result kolonh) 2 2)
			 " m\U+00B3"
		 )
	)
      )
    )
  )
  (princ)
)

Also:

[k005]

Thank you. @ronjonp 

[ronjonp]

---

@k005 wrote:

Thank you. @ronjonp 

---

Glad to help 👍