topic Re: Lisp code add in Visual LISP, AutoLISP and General Customization Forum

Lisp code add

k005 — Tue, 11 Oct 2022 10:00:22 GMT

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")) )

Re: Lisp code add

3wood — Wed, 12 Oct 2022 11:23:39 GMT

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

Re: Lisp code add

k005 — Wed, 12 Oct 2022 13:03:34 GMT

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

Re: Lisp code add

ronjonp — Wed, 12 Oct 2022 21:28:09 GMT

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:

Re: Lisp code add

k005 — Thu, 13 Oct 2022 04:23:36 GMT

Thank you. @ronjonp

Re: Lisp code add

ronjonp — Thu, 13 Oct 2022 14:41:07 GMT

@k005 wrote:

Thank you. @ronjonp

Glad to help 👍