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

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

Sign In

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

Recommended Posts

Nikon

Steven P

mhupp

Nikon

Steven P

Nikon

Nikon

Nikon

BIGAL

Nikon

Nikon

Nikon

Join the conversation

Tutorials

Forums

Activity