Sum Text Strings to Text Field...

Hi there,

I have 2 lisp routines: first one is creating a label with area of selected hatch (as a text field, so if area of hatch will change, label will change too). Second one is creating a label with sum of numbers in selected texts (as a standard text). My question is: how to edit second routine that instead of creating a label as a standard text, this will create a label using text field, so if areas will change, label with sum of all areas will change too. Thanks for help in advance and sorry for my bad English

1 - farea.zip

2 - stx.lsp

Please try:

;; TEXT SUM TO FIELD
;;
(defun c:Fsum (/ lst pt ss)
   (vl-load-com)
   (prompt "\nSelect text to add numbers.")
   (if (setq ss (ssget '((0 . "TEXT,MTEXT"))))
       (progn
           (setq pt (vlax-3D-Point (getpoint "\n Select Point: ")))
           (setq lst
                    (strcat
                        "%<\\AcExpr \("
                        (vl-string-right-trim
                            "+"
                            (apply 'strcat
                                   (mapcar
                                       '(lambda (x)
                                            (strcat
                                                "%<\\AcObjProp Object(%<\\_ObjId "
                                                (itoa x)
                                                ">%).TextString>% +"
                                            )
                                        )
                                       (mapcar
                                           'vla-get-objectid
                                           (mapcar
                                               'vlax-ename->vla-object
                                               (vl-remove-if
                                                   'listp
                                                   (mapcar 'cadr (ssnamex ss))
                                               )
                                           )
                                       )
                                   )
                            )
                        )
                        "\)>%"
                    )
           )
           (vla-addMText
               (if (zerop
                       (vla-get-activespace
                           (setq Activ_doc
                                    (vla-get-activedocument
                                        (vlax-get-acad-object)
                                    )
                           )
                       )
                   )
                   (vla-get-paperspace Activ_doc)
                   (vla-get-modelspace Activ_doc)
               )
               pt
               0.0
               lst
           )
       )
   )
   (princ)
)
;;
;;WIZ_12JAN10

Wow - this is a quick replay thank you for your help

Unfortunately not working.

Command Line is giving me:

%

2128590376>%).TextString>% +%

2128590368>%).TextString>% )>%"%

2128590376>%).TextString>% +%

2128590368>%).TextString>% )>%"

after I've selected point.

Tomjas, Any Value you want on the commandline? currently the lisp prints to the commandline that value you've seen but it can easily be changed. How about the field inside mtext is it working fine? if you see "####" just do a regen.

please try again, i see now where i'm missing

when is asking me Select objects:

I'm selecting 2 mtext

then asking me Select Point:

I'm selecting point

now I have:

error: no function definition: VLAX-3D-POINT

in command line

Please find enclosed file (cad 2007 format) which I'm using

I'm using CAD 2009 and 2010

Drawing1.dwg

Try this:

;; TEXT SUM TO FIELD
;;
(defun c:Fsum (/ lst pt ss)
 (vl-load-com)
 (prompt "\nSelect text to add numbers.")
 (if (setq ss (ssget '((0 . "TEXT,MTEXT"))))
   (progn
     (setq pt (vlax-3D-Point (getpoint "\n Select Point: ")))
     (setq lst
            (strcat
              "%<\\AcExpr \("
              (vl-string-right-trim
                "+"
                (apply 'strcat
                       (mapcar
                         '(lambda (x)
                            (strcat
                              "%<\\AcObjProp Object(%<\\_ObjId "
                              (itoa x)
                              ">%).TextString>% +"
                            )
                          )
                         (mapcar
                           'vla-get-objectid
                           (mapcar
                             'vlax-ename->vla-object
                             (vl-remove-if 'listp
                               (mapcar 'cadr (ssnamex ss)))
                           )
                         )
                       )
                )
              )
              "\)>%"
            )
     )
     (vla-addMText
       (vla-get-modelspace
         (vla-get-ActiveDocument
           (vlax-get-acad-object)
         )
       )
       pt
       0.0
       lst
     )
   )
 )
 ;(princ lst)
 (princ)
)
;;
;;WIZ_12JAN10

Nice code btw Wiz

I just updated it again,

your quicker than my edit Lee. Thanks

OMG

This is great!!!!!!!!!!!!!!!!!!!!!!!!!!!! Working great!!!!!!!!!!!!!!!

Now 2 small questions/ options

1: Is it possible to match properties of (let say) first selected object?

2: What if I have a suffix 'm2' on the end of my area labels, can we have the same suffix in final label or at least result without any suffix? Now we have ####

I know I'm asking for sky, but...

Once again please see attached cad file

Drawing2.dwg

Another method:

(defun c:FSum2 (/ Units Prec FldStr pt ss)
 ;; Lee Mac  ~  12.01.10
 (vl-load-com)
 (setq Units 2 Prec 3) ;; Accuracy

 (setq doc (cond (doc) ((vla-get-ActiveDocument
                          (vlax-get-Acad-Object)))))
 
 (setq FldStr "%<\\AcExpr \(")  
 (if (and (ssget '((0 . "TEXT,MTEXT")))
          (setq pt (getpoint "\nSelect Point for Field: ")))
   (progn
     (vlax-for obj (setq ss (vla-Get-ActiveSelectionSet doc))

       (setq FldStr
        (strcat FldStr
          "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectId Obj)) ">%).TextString>% +")))

     (vla-Delete ss)

     (vla-AddMText (vla-get-ModelSpace doc)
       (vlax-3D-point pt) 0. (setq FldStr
         (strcat (substr FldStr 1 (1- (strlen FldStr)))
                  "\) \\f \"%lu" (itoa Units) "%pr" (itoa Prec) "\">%")))))  

 (princ))

Try this:

(defun c:FSum2 (/ Units Prec Suff First fObj FldStr pt ss)
 ;; Lee Mac  ~  12.01.10
 (vl-load-com)
 [color=Blue][b](setq Units 2 Prec 3 Suff "m2") ;; Formatting[/b][/color]

 (setq doc (cond (doc) ((vla-get-ActiveDocument
                          (vlax-get-Acad-Object)))))
 
 (setq FldStr "%<\\AcExpr \(")  
 (if (and (ssget '((0 . "TEXT,MTEXT")))
          (setq pt (getpoint "\nSelect Point for Field: ")))
   (progn
     (vlax-for obj (setq ss (vla-Get-ActiveSelectionSet doc))
       (or First (setq First obj))

       (setq FldStr
        (strcat FldStr
          "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectId Obj)) ">%).TextString>% +")))

     (vla-Delete ss)

     (setq FObj
       (vla-AddMText (vla-get-ModelSpace doc)
         (vlax-3D-point pt) 0. (setq FldStr
           (strcat (substr FldStr 1 (1- (strlen FldStr)))
                    "\) \\f \"%lu" (itoa Units) "%pr" (itoa Prec) "%ps[," Suff "]\">%"))))

     (mapcar
       (function
         (lambda (property)
           (and (vlax-property-available-p First property)
                (vlax-put-property FObj property
                  (vlax-get-property First property)))))

       '(Layer Color StyleName Width))))                  

 (princ))

OMG

 

This is great!!!!!!!!!!!!!!!!!!!!!!!!!!!! Working great!!!!!!!!!!!!!!!

 

Now 2 small questions/ options

 

1: Is it possible to match properties of (let say) first selected object?

 

2: What if I have a suffix 'm2' on the end of my area labels, can we have the same suffix in final label or at least result without any suffix? Now we have ####

 

I know I'm asking for sky, but...

 

Once again please see attached cad file

Its Harder now, , with suffixes is not that easy for fields' computation, be back if i find a solution, may be lee can come up with one. good code also lee.

Its Harder now, , with suffixes is not that easy for fields' computation, be back if i find a solution, may be lee can come up with one. good code also lee.

Thanks Wiz,

Adding the suffix to the result isn't a problem, but I cannot see a way to make the field recognise to remove the "m2" from a string...

Yup Lee, String it is and not part of the field. Challenging hey..'-)

How about this

(defun c:FSum2 (/ Units Prec Suff First fObj FldStr pt ss)
 ;; Lee Mac  ~  12.01.10
 (vl-load-com)
 (setq Units 2 Prec 3 Suff "m2") ;; Formatting

 (setq doc (cond (doc) ((vla-get-ActiveDocument
                          (vlax-get-Acad-Object)))))
 
 (setq FldStr "%<\\AcExpr \(")  
 (if (and (ssget '((0 . "TEXT,MTEXT")))
          (setq pt (getpoint "\nSelect Point for Field: ")))
   (progn
     (vlax-for obj (setq ss (vla-Get-ActiveSelectionSet doc))
       (or First (setq First obj))

       (setq FldStr
        (strcat FldStr
          "%<\\AcDiesel $(substr,%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectId Obj))
          ">%).TextString>%,1,$(-,$(strlen,%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectId Obj))
          ">%).TextString>%),2))>% +")))

     (vla-Delete ss)

     (setq FObj
       (vla-AddMText (vla-get-ModelSpace doc)
         (vlax-3D-point pt) 0. (setq FldStr
           (strcat (substr FldStr 1 (1- (strlen FldStr)))
                    "\) \\f \"%lu" (itoa Units) "%pr" (itoa Prec) "%ps[," Suff "]\">%"))))

     (mapcar
       (function
         (lambda (property)
           (and (vlax-property-available-p First property)
                (vlax-put-property FObj property
                  (vlax-get-property First property)))))

       '(Layer Color StyleName Width))))                  

 (princ))

Wiz - You are my hero

Thanks for your help

Lee - You are my hero too

Formating is working great!! I will probably look for more properties ie. text height

If you can look to stx.lsp file, wich I've attached - and look for 'inspiration' as this routine is doing this

You guys know what '{' mean - I know only how to load lsp to CAD

stx.lsp

Congrats Lee, you beat me to it, learned from your solution..'-)

Tomjas, Get last code by Lee, happy to assist you.

Working

You will hate me, but what if there is a 'ha' or 'mm2' instead of 'm2' in area label. This one is great, but I'm working with some 'CAD users' who like to make a messssssssssss and change things...

Working

 

You will hate me, but what if there is a 'ha' or 'mm2' instead of 'm2' in area label. This one is great, but I'm working with some 'CAD users' who like to make a messssssssssss and change things...

Haha not a chance mate...

On a side note... Wiz, could you collaborate to see if we can get this working? (just for academia)

(defun c:FSum2 (/ Units Prec Suff First fObj FldStr pt ss)
 ;; Lee Mac  ~  12.01.10
 (vl-load-com)
 (setq Units 2 Prec 3 Suff "m2") ;; Formatting

 (setq doc (cond (doc) ((vla-get-ActiveDocument
                          (vlax-get-Acad-Object)))))
 
 (setq FldStr "%<\\AcExpr \(")  
 (if (and (ssget '((0 . "TEXT,MTEXT")))
          (setq pt (getpoint "\nSelect Point for Field: ")))
   (progn
     (vlax-for obj (setq ss (vla-Get-ActiveSelectionSet doc))
       (or First (setq First obj))

       (setq FldStr
        (strcat FldStr
          "%<\\AcDiesel $(if,$(eq,\"m2\",$(substr,%<\\AcObjProp Object(%<\\_ObjId "  (itoa (vla-get-ObjectId Obj))
                   ">%).TextString>%,$(-,$(strlen,%<\\AcObjProp Object(%<\\_ObjId "  (itoa (vla-get-ObjectId Obj))
                 ">%).TextString>%),2))),$(substr,%<\\AcObjProp Object(%<\\_ObjId "  (itoa (vla-get-ObjectId Obj))
                 ">%).TextString>%,1,$(-,$(strlen,%<\\AcObjProp Object(%<\\_ObjId "  (itoa (vla-get-ObjectId Obj))
                           ">%).TextString>%),2)),%<\\AcObjProp Object(%<\\_ObjId "  (itoa (vla-get-ObjectId Obj))
                ">%).TextString>%)>% +")))

     (vla-Delete ss)

     (setq FObj
       (vla-AddMText (vla-get-ModelSpace doc)
         (vlax-3D-point pt) 0. (setq FldStr
           (strcat (substr FldStr 1 (1- (strlen FldStr)))
                    "\) \\f \"%lu" (itoa Units) "%pr" (itoa Prec) "%ps[," Suff "]\">%"))))

     (mapcar
       (function
         (lambda (property)
           (and (vlax-property-available-p First property)
                (vlax-put-property FObj property
                  (vlax-get-property First property)))))

       '(Layer Color StyleName Width))))                  

 (princ))

Hi,

Here's my way, it works with fields nested in blocks or tables and with fields cearted by AddFields too.

I keeps the field format (precision, prefix, suffix) of the last selected fied.

;; ADDFIELDS (gile)
;; Insert a text field wich value is the sum of selected fields

(defun c:AddFields (/ *error* ent lst res code pos ins)
 (vl-load-com)

 (defun *error* (msg)
   (or (= msg "Fuction cancelled")
       (princ (strcat "Error: " msg))
   )
   (mapcar (function (lambda (x) (redraw (car x) 4))) lst)
   (princ)
 )
 
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (while (setq ent (car (nentsel "\nSelect a field: ")))
   (if (and
         (setq code (gc:FieldCode ent))
         (setq pos (vl-string-search "%<" code))
         (setq code (substr code (1+ pos)))
         (setq pos (vl-string-position 37 code 1 T))
         (setq code (substr code 1 (1+ pos)))
       )
     (if (assoc ent lst)
   (progn
     (setq lst (vl-remove (assoc ent lst) lst))
     (redraw ent 4)
   )
   (progn
     (setq lst (cons (cons ent code) lst))
     (redraw ent 3)
   )
     )
     (princ "\nEntité non valide")
   )
 )
 (if (and lst
          (setq ins (getpoint "\nInsertion point: "))
     )
   (progn
     (setq
       res (strcat "%<\\AcExpr "
                   (lst2str (mapcar 'cdr lst) " + ")
                   " "
                   (if (setq pos (vl-string-position (ascii "\\") code 1 T))
                     (substr code (1+ pos))
                     ">%"
                   )
           )
     )
     (mapcar (function (lambda (x) (redraw (car x) 4))) lst)
     (vla-addText
         (if (= 1 (getvar 'cvport))
           (vla-get-PaperSpace *acdoc*)
           (vla-get-ModelSpace *acdoc*)
         )
         res
         (vlax-3d-point (trans ins 1 0))
         (getvar 'textsize)
       )  
   )
 )
 (princ)
)

;;========================= ROUTINES =========================;;

;; gc:FieldCode (gile)
;; Returns the string value of a text mtext or attribute with field code
;;
;; Argument : the entity name (ENAME)

(defun gc:FieldCode (ent / foo elst xdict dict field str)

 ;;--------------------------------------------------------;;
 (defun foo (field str / pos fldID objID)
   (setq pos 0)
   (if (setq pos (vl-string-search "\\_FldIdx " str pos))
     (while (setq pos (vl-string-search "\\_FldIdx " str pos))
       (setq fldId (entget (cdr (assoc 360 field)))
             field (vl-remove (assoc 360 field) field)
             str   (strcat
                     (substr str 1 pos)
                     (if (setq objID (cdr (assoc 331 fldId)))
                       (vl-string-subst
                         (strcat "ObjId " (itoa (gc:EnameToObjectId objID)))
                         "ObjIdx"
                         (cdr (assoc 2 fldId))
                       )
                       (foo fldId (cdr (assoc 2 fldId)))
                     )
                     (substr str (1+ (vl-string-search ">%" str pos)))
                   )
       )
     )
     str
   )
 )
 ;;--------------------------------------------------------;;
 
 (setq elst (entget ent))
 (if (and
   (member (cdr (assoc 0 elst)) '("ATTRIB" "MTEXT" "TEXT"))
   (setq xdict (cdr (assoc 360 elst)))
   (setq dict (dictsearch xdict "ACAD_FIELD"))
   (setq field (dictsearch (cdr (assoc -1 dict)) "TEXT"))
     )
   (setq str (foo field (cdr (assoc 2 field))))
 )
)

;;============================================================;;

;; gc:EnameToObjectId (gile)
;; Returns the ObjectId from an ename
;;
;; Argument : an ename

(defun gc:EnameToObjectId (ename)
 ((lambda (str)
    (hex2dec
      (substr (vl-string-right-trim ">" str) (+ 3 (vl-string-search ":" str)))
    )
  )
   (vl-princ-to-string ename)
 )
)

;;============================================================;;

;; hex2dec (gile)
;; Converts an hexadecimal (string) to a decimal (int)
;;
;; Argument : a string figuring an hexadecimal

(defun hex2dec (s / r l n)
 (setq    r 0 l (vl-string->list (strcase s)))
 (while (setq n (car l))
   (setq l (cdr l)
         r (+ (* r 16) (- n (if (<= n 57) 48 55)))
   )
 )
)

;;============================================================;;

;; lst2str (gile)
;; Concatenates a list of strings and a separator into a string
;;
;; Arguments
;; lst : the list to convert
;; sep : the separator (string)

(defun lst2str (lst sep)
 (if (cdr lst)
   (strcat (car lst) sep (lst2str (cdr lst) sep))
   (car lst)
 )
)

Good Code Gile, thanks,