Выбрать тексты на чертеже и получить поле суммы

January 3, 2023

Всем привет, с новым годом! Как с помощью лисп получить код поля суммы выбранных текстов (Мтекстов).
Выбрать тексты на чертеже рамкой или по одному и получить поле суммы.

January 3, 2023

Copied and pasted from other stuff I have and probably more efficient ways to do this

Commands:

txtsum will display the result in the command line and copy it into the clipboard

txtsumtt will ask for target text to copy the sum into

I think it works with fields, can be a bit variable with summing dimension values, but should do the example above

(defun txtsum ( / entlist1 entcodes1 ent1 text01 textsum acount textss)
;;Variables
  (setq textsum 0)
  (setq acount 0)

;;Select Text
  (princ "\nSelect numbers to sum")
  (setq textss (ssget '((0 . "*TEXT,DIMENSION"))) )
  (while (< acount (sslength textss))
    (setq ent1 (ssname textss acount))
    (setq entlist1 (entget ent1))
    (setq entcodes1 (gettextdxfcodes entlist1) ) ;list of ent codes containing text.
    (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string
    (setq textsum (+ textsum (atof text01)) )
    (setq acount (+ acount 1))
  )
  textsum
)
(defun c:txtsum ( / textsum)
  (setq textsum (txtsum) )
  (princ "Total: ")
  (princ textsum)
;;Copy result to clipboard
(vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'setData "TEXT" (rtos textsum) )
  (vlax-release-object html)
  (princ)
)
(defun c:txtsumtt ( / textsum ent1 entlist1 entcodes1 text01)
  (setq textsum (txtsum) )
  (if (setq ent1 (getent "\nSelect Text to Update (or escape): "))
    (progn
      (setq entlist1 (entget ent1))
      (setq entcodes1 (gettextdxfcodes entlist1) ) ;list of ent codes containing text.
      (setq text01 (gettextasstring ent1 entcodes1) ) ;Text as string
      (addinnewtext textsum entlist1 ent1)
      (command "redraw")
      (command "regen") ;;update it all
    )
  )

;;Copy result to clipboard
(vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'setData "TEXT" (rtos textsum) )
  (vlax-release-object html)
  (princ)
)

;;;Sub routines
(defun gettextdxfcodes ( entlist1 / dxfcodes)
;;DXF codes containing texts
  (setq dxfcodes (list 3 4 1 172 304)) ;;general
  (if (= (cdr (assoc 0 entlist1)) "DIMENSION") ;;If Dimension
    (progn
      (if (= (cdr (assoc 1 entlist1)) nil)
        (setq dxfcodes (list 4 42 172 304)) ;;No 3, add 42 for dimension value
        (if (and (= (wcmatch "<>" (cdr (assoc 1 entlist1))) nil)(= (wcmatch "\"\"" (cdr (assoc 1 entlist1))) nil) )
          (setq dxfcodes (list 4 1 172 304)) ;;No 3, no 42 for dimension value
          (setq dxfcodes (list 4 1 42 172 304)) ;;Somehow combine 1 and 42 here, text replace and so on.
        ) ;end if
      ) ;end if
  ));end progn end if Dimensions
  (if (= (cdr (assoc 0 entlist1)) "MULTILEADER") ;;Is MultiLeader
    (progn
      (setq dxfcodes (list 304))
  ));end progn end if Dimensions
  dxfcodes
)


(defun getfroment (ent listorstring entcodes / acount acounter mytext newtext stringtext)
;;get dotted pairs list
  (setq entlist (entget ent))
  (if ( = (cdr (assoc 0 entlist)) "RTEXT")
    (progn
      (setq mytext (getrtext entlist))
    ) ; end progn
    (progn
      (setq enttype (cdr (assoc 0 entlist)))
      (setq acount 0)
      (while (< acount (length entlist))
        (setq acounter 0)
        (while (< acounter (length entcodes))
          (setq entcode (nth acounter entcodes))
          (if (= (car (nth acount entlist)) entcode )
            (progn
              (setq newtext (cdr (nth acount entlist)))
              (if (numberp newtext)(setq newtext (rtos newtext))) ;fix for real numbers
              (setq mytext (append mytext (list (cons (car (nth acount entlist)) newtext) )) )
            );end progn
          );end if
          (setq acounter (+ acounter 1))
        );end while
        (setq acount (+ acount 1))
      );end while
;;get string from dotted pair lists
      (if (= listorstring "astring") ;convert to text
        (progn
          (if (> (length mytext) 0)
            (progn
              (setq acount 0)
              (setq temptext "")
              (while (< acount (length mytext))
                (setq temptext (cdr (nth acount mytext)) )
                (if (= (wcmatch temptext "LEADER_LINE*") nil)()(setq temptext "")) ;;Fix for Multileader 'Leader_Line' Text
                (if (= stringtext nil)
                  (setq stringtext temptext)
                  (setq stringtext (strcat stringtext temptext ))
                );end if
                (setq acount (+ acount 1))
              );end while
            );end progn
          );end if
          (if (= stringtext nil)(setq stringtext ""))
          (setq mytext stringtext)
        );end progn
      );end if
    );end progn
  ); end if
  mytext
)

;;get text as a string
(defun gettextasstring ( enta entcodes / texta )
  (if (= (getfroment enta "astring" entcodes) "")
    ()
    (setq texta (getfroment enta "astring" entcodes))
  )
  texta
)



(defun addinnewtext (newtext newentlist newent / )
  (if (/= newtext nil)
    (progn
      (cond
        ( (= (cdr (assoc 0 newentlist)) "DIMENSION")
          (entmod (setq newentlist (subst (cons 1 newtext) (assoc 1 newentlist) newentlist)))
          (entupd newent)
        );end condition

        ( (= (cdr (assoc 0 newentlist)) "RTEXT")
          (princ "\nRtext: Unwilling to update source file (")
          (princ (cdr (assoc 1 newentlist)) )
          (princ ")")
        );end condition
        (t ;everything else
;;vla-put-text string for large text blocks + 2000 characters?
          (vla-put-textstring (vlax-ename->vla-object newent) newtext)
        );end condition
      ) ;end cond
    ) ;end progn
    (princ "\nSource text is not 'text'")
  );end if
)

Edited January 3, 2023 by Steven P

January 3, 2023

FYI You should release the clipboard interface after pasting to it.

;;Copy result to clipboard
(vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'setData "TEXT" (rtos textsum) )
(vlax-release-object html)

http://www.theswamp.org/index.php?PHPSESSID=2aae48e2b4c9aa47e060a29940641d81&topic=44212.msg494826#msg494826

January 3, 2023

Всем спасибо!

Проблема в том, что надо сумму текстов вставить ПОЛЕМ в чертеж.

Нужен код поля суммы текстов на лиспе.

January 3, 2023

2 hours ago, mhupp said:
FYI You should release the clipboard interface after pasting to it.
;;Copy result to clipboard
(vlax-invoke (vlax-get (vlax-get (vlax-create-object "htmlfile") 'ParentWindow) 'ClipBoardData) 'setData "TEXT" (rtos textsum) )
(vlax-release-object html)
http://www.theswamp.org/index.php?PHPSESSID=2aae48e2b4c9aa47e060a29940641d81&topic=44212.msg494826#msg494826

Thanks.. again.. I think you have told me that before - I have a small LISP copy to clipboard releasing the interface but didn't change that in the mathematical functions I have - all good now and updating the above code

January 3, 2023

Если в чертеже просуммировать 4 текста, то получается такой код поля

%<\AcExpr (%<\_FldPtr 849676608>%+%<\_FldPtr 849681696>%+%<\_FldPtr 849675392>%+%<\_FldPtr 849682048>%) \f "%lu2">%

Как с помощью ЛИСП создать код поля суммы для множества текстов и вставить это поле в чертеж

Будет что-то такого типа

"%<\\AcObjProp Object(%<\\_ObjId "

            (LM:objectid (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))

                                 ">%).TextString>%" " + "

                                 lst

January 13, 2023

Есть лисп, суммирование текста и вывод суммы полем, но поле не выводится, в чем проблема?

CALC-TEXT-VALUE-FLD

(defun c:calc-text-value-fld (/ value ent obj ss)
	 (vl-load-com)
	 (princ
	   "\nВыберите текстовые объекты среди которых будет произведена калькуляция"
	   ) ;_ princ
	 (setq ss (ssget '((0 . "TEXT,MTEXT"))))
	 (if (not ss)
	   (princ "Не выбраны объекты")
	   (progn
	     (setq
	 value (rtos
	   (apply
	     (function +)
	     (mapcar
	       (function
	         (lambda (a)
	     (atof
	       (vl-string-trim
	         "%Uu {\\Ll}"
	         (vl-string-subst
	           "."
	           ","
	           (cdr (assoc 1 (entget a)))
	           ) ;_ vl-string-subst
	         ) ;_ vl-string-trim
	       ) ;_ atof
	     ) ;_ lambda
	         ) ;_ function
	       (vl-remove-if
	         (function listp)
	         (mapcar (function cadr)
	           (ssnamex ss)
	           ) ;_ mapcar
	         ) ;_ vl-remove-if
	       ) ;_ mapcar
	     ) ;_ apply
	   ) ;_ rtos
	 ) ;_ setq
	     (if (vl-string-position (ascii ".") value)
	 (setq value (vl-string-right-trim ".0" value))
	 ) ;_ if
	     (princ (strcat "\n Сумма = " value))
	     (setvar "ERRNO" 0)
	     (if (and ent
	        (vlax-property-available-p
	    (setq obj (vlax-ename->vla-object ent))
	    'TextString
	    ) ;_ vlax-property-available-p
	        ) ;_ and
	 (progn
	   (vlax-put-property obj 'TextString value)
	 (vlax-put-property obj 'Height 250)
	   (vlax-release-object obj)
	   ) ;_ progn
	 ) ;_ if
	     ) ;_ progn
	   ) ;_ if
	 (setq pt2 (getpoint))
(setq fld (strcat "%<\\AcObjProp Object(%<\\_ObjId "
            (vl-princ-to-string(vla-get-objectid (vlax-ename->vla-object en)))
               ">%).TextString \\f \""%lu2%pr2" (itoa *PREC*) "%ct8["(vl-princ-to-string *SCALE*)"]\">%"
               ) ;_ strcat
         ) ;_ setq
	 (setq r (* (getvar "DIMSCALE") (getvar "DIMTXT")))
	  (command "_text" pt2 r 0 value)
	 (princ)
	 ) ;_ defun

January 20, 2023

Есть решение на форуме dwg.ru. https://forum.dwg.ru/showthread.php?t=166934
Поле суммы нескольких текстов Автор gumel & Lee Mak

При сложении десятичных чисел, поле суммы выводится с 6 знаками после точки, например 200.456000, как можно исправить код, чтобы было 2 знака - 200.46?

;;  Author: Lee Mac & dwg.ru, Copyright © 2014  -  www.lee-mac.com              ;;

(defun c:t2f ( / *error* fmt inc ins lst sel str )

    (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )

    (if (and (setq sel (ssget '((0 . "TEXT,MTEXT"))))
             (setq ins (getpoint "\nPick point or cell for field: "))
        )
        (progn
            (if (setq tmp
                    (ssget "_X"
                        (list '(0 . "ACAD_TABLE")
                            (if (= 1 (getvar 'cvport))
                                (cons 410 (getvar 'ctab))
                               '(410 . "Model")
                            )
                        )
                    )
                )
                (repeat (setq idx (sslength tmp))
                    (setq tab (cons (vlax-ename->vla-object (ssname tmp (setq idx (1- idx)))) tab))
                )
            )
            (if (= 1 (sslength sel))
                (setq str
                    (strcat
                        "%<\\AcObjProp Object(%<\\_ObjId "
                        (LM:ObjectID (vlax-ename->vla-object (ssname sel 0)))
                        ">%).TextString>%"
                    )
                )
                (progn
                    (repeat (setq idx (sslength sel))
                        (setq lst
                            (vl-list*
                                "%<\\AcObjProp Object(%<\\_ObjId "
                                (LM:ObjectID (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
                                ">%).TextString>%" " + "
                                lst
                            )
                        )
                    )
                    (setq str
                        (strcat
                            "%<\\AcExpr "
                            (apply 'strcat (reverse (cdr (reverse lst))))
                            ">%"
                        )
                    )
                )
            )
            (LM:startundo (LM:acdoc))
            (if (setq tmp (LM:getcell tab (trans ins 1 0)))
                (apply 'vla-settext (append tmp (list str)))
                (vla-addmtext
                    (vlax-get-property (LM:acdoc) (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace))
                    (vlax-3D-point (trans ins 1 0))
                    0.0
                    str
                )
            )
            (LM:endundo (LM:acdoc))
        )
    )
    (princ)
)

;; Returns a string containing the ObjectID of a supplied VLA-Object
 
(defun LM:ObjectID ( obj )
    (eval
        (list 'defun 'LM:ObjectID '( obj )
            (if
                (and
                    (vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
                    (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
                )
                (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
               '(itoa (vla-get-objectid obj))
            )
        )
    )
    (LM:ObjectID obj)
)

;; Opens an Undo Group.
 
(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)
 
;; Closes an Undo Group.
 
(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)
 
;; Returns the VLA Active Document Object
 
(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)
 
(vl-load-com) (princ)

January 21, 2023

You can format the string will see if can find time to change code.

%<\AcObjProp Object(%<\_ObjId 2129673136>%).Area \f "%lu6%qf1">% ;; Area field formatting

Edited January 21, 2023 by BIGAL

January 21, 2023

thanks, @BIGAL

Edited December 14, 2023 by Nikon

January 22, 2023

Надо так (setq fmt "%lu2%pr2%")

September 3, 2023

There is a solution in this 2010 topic.

https://www.cadtutor.net/forum/topic/17288-sum-text-strings-to-text-field/#comment-142106

Fsum, Fsum2 Summarizes text strings into a text field.

Edited September 3, 2023 by Nikon

Выбрать тексты на чертеже и получить поле суммы

Recommended Posts

Nikon

Link to comment

Share on other sites

Steven P

Link to comment

Share on other sites

mhupp

Link to comment

Share on other sites

Nikon

Link to comment

Share on other sites

Steven P

Link to comment

Share on other sites

Nikon

Link to comment

Share on other sites

Nikon

Link to comment

Share on other sites

Nikon

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

Nikon

Link to comment

Share on other sites

Nikon

Link to comment

Share on other sites

Nikon

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity