Sum Text Strings to Text Field...

January 13, 2010

than there is that extra button: Additional Format:
and you can set the conversion factor there...

Gotcha, I'm a programmer, not a drafter

January 13, 2010

Try this:

(defun c:a2f (/ *error* Stringify ENT OBJ PT TMP TOBJ TYP UFLAG)
 ;; Lee Mac  ~  13.01.10
 (vl-load-com)

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark *doc*))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 

 (defun Stringify (x / typ)
   (cond (  (eq 'REAL (setq typ (type x)))
            (rtos x))
         (  (eq 'INT typ)
            (itoa x))
         (  (eq 'STR typ) x)
         (t (vl-princ-to-string x))))
 

 (setq *doc* (cond (*doc*) ((vla-get-ActiveDocument
                              (vlax-get-acad-object))))

       *spc* (cond (*spc*) ((if (zerop (vla-get-activespace *doc*))
                              (if (= (vla-get-mspace *doc* :vlax-true))
                                (vla-get-modelspace *doc*)
                                (vla-get-paperspace *doc*))
                              (vla-get-modelspace *doc*)))))

 (or *a2f_Uni (setq *a2f_Uni 2))
 (or *a2f_Pre (setq *a2f_Pre 3))
 (or *a2f_Con (setq *a2f_Con 1.))
 (or *a2f_Hgt (setq *a2f_Hgt (getvar 'TEXTSIZE)))
 (or *a2f_Rot (setq *a2f_Rot 0.))
 (or *a2f_Suf (setq *a2f_Suf "m2"))

 (mapcar (function set) '(*a2f_Uni *a2f_Pre *a2f_Con *a2f_Hgt *a2f_Rot *a2f_Suf)
         (mapcar
           (function
             (lambda (ini foo msg x)
               (and ini (initget ini))
               (cond ((and (setq tmp ((eval foo) (strcat msg " <" (Stringify x) "> : ")))
                           (/= "" tmp)) tmp)
                     (x))))
            
            (list 6 4 6 6 nil nil)
           '(GetInt GetInt GetReal GetDist GetAngle GetString)
           '("Specify Units" "Specify Precision" "Specify Conversion Factor"
             "Specify Text Height" "Specify Text Rotation" "Specify Suffix")
            (list *a2f_Uni *a2f_Pre *a2f_Con *a2f_Hgt *a2f_Rot *a2f_Suf)))
           
 (while
   (progn
     (setq ent (car (entsel "\n>> Pick Hatch, Circle or Closed Polyline >>")))

     (cond (  (eq 'ENAME (type ent))

              (if (vlax-property-available-p
                    (setq obj (vlax-ename->vla-object ent)) 'Area)
                
                (if (setq pt (getpoint "\nPick Point for Field: "))
                  (progn
                    (setq uFlag (not (vla-StartUndoMark *doc*)))

                    (setq tObj
                      (vla-AddMText *spc* (vlax-3D-point pt) 0.0
                        (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                                (vl-princ-to-string (vla-get-ObjectId obj))
                                ">%).Area \\f \"%lu" (itoa *a2f_Uni) "%pr"
                                (itoa *a2f_Pre) "%ps[," *a2f_Suf "]%ct8[" (rtos *a2f_Con) "]\">%")))

                    (mapcar
                      (function
                        (lambda (property value)
                          (vlax-put-property tObj property value)))

                      '(Height Rotation Layer Color)
                       (list *a2f_Hgt *a2f_Rot (vlax-get-property obj 'Layer)
                                               (vlax-get-property obj 'Color)))

                    (setq uFlag (vla-EndUndoMark *doc*))

                    t) ;; repeat

                  )

                (princ "\n** Invalid Object Selected **"))))))
 (princ))

January 13, 2010

:shock:

I'm afraid to ask you for more changes

Working great (but not on solid hatch)- any ideas why?

Gile's code- excellent but is matching layer of first selected object and other properties (suffix, precision) from object selected as a last

Sorry for making so many problems

and I've found another BIG issue wit gile's code. You need to select each label individually rather than all of them on one go- you can imagine what will happen if you have 2000 labels with areas!!!!! Any solution?

January 13, 2010

Working great (but not on solid hatch)- any ideas why?

Seems to work ok for me...

Gile's code- excellent but is matching layer of first selected object and other properties (suffix, precision) from object selected as a last

Sorry for making so many problems

and I've found another BIG issue wit gile's code. You need to select each label individually rather than all of them on one go- you can imagine what will happen if you have 2000 labels with areas!!!!! Any solution?

I don't particularly want to mess with Gile's code too much, as I'd rather let him modify his own routine. :wink: but I can see what I can do

January 13, 2010

Try this:

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

;; Modified by Lee Mac to Accept SelSet

(defun c:AddFields (/ *error* i ss fObj ent code pos lst res tObj)
 (vl-load-com)

 (defun *error* (msg)
   (or (= msg "Fuction cancelled")
       (princ (strcat "Error: " msg)))
   (princ))
 
 (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))))

 (if (setq i -1 ss (ssget '((0 . "MTEXT,TEXT"))))
   (progn
     (setq fObj (vlax-ename->vla-object (ssname ss 0)))
     
     (while (setq ent (ssname ss (setq i (1+ i))))

       (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)
           (setq lst (vl-remove (assoc ent lst) lst))
           (setq lst (cons (cons ent code) lst)))))

     (if (and lst (setq ins (getpoint "\nPick Point for Field: ")))
       (progn
         (setq code (cdr (last lst))

               res (strcat "%<\\AcExpr "
                           (lst2str (mapcar (function cdr) lst) " + ")
                           " " (if (setq pos (vl-string-position (ascii "\\") code 1 t))
                                 (substr code (1+ pos)) ">%")))

         (setq TObj (vla-addText
                      (if (= 1 (getvar 'cvport))
                        (vla-get-PaperSpace *acdoc*)
                        (vla-get-ModelSpace *acdoc*)) res
                      (vlax-3d-point (trans ins 1 0))
                      (getvar 'textsize)))          
         (mapcar
           (function
             (lambda (x)
               (vlax-put-property tObj x
                 (vlax-get-property fObj x)))) '(Layer Color))))))

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

Apologies for messing with your code Gile.

January 13, 2010

but I can see what I can do

sounds good to me

I'm using Civil 3d 2010 at home and is not working with solid hatch!

I'll try at work tomorrow morning with CAD 2009, 2010 and Civil 2009, 2010- will see is there any difference.

Have a nice evening!

January 13, 2010

Apologies for messing with your code Gile.

No need to apologize, Lee, I had no time to do it...

January 13, 2010

I'm using Civil 3d 2010 at home and is not working with solid hatch!

When you say it is not working - what happens?? Does it throw an error? Does the field show ####?

January 13, 2010

SORTED GUYS!!!

I've change some settings with selecting objects and is working GREAT!

THANK YOU VERY MUCH!!!

January 13, 2010

SORTED GUYS!!!

I've change some settings with selecting objects and is working GREAT!

THANK YOU VERY MUCH!!!

Does the Hatch now work? Are you referring to the code I modified above?

January 13, 2010

solid hatch is working now (I've change my civil 3d settings)

once again thank you very much

January 13, 2010

solid hatch is working now (I've change my civil 3d settings)

once again thank you very much

Excellent

January 14, 2010

Good Job, Lee...'-)

January 14, 2010

Is there any easy way to change a2f routine (by Lee) to be able to select only hatch (not circle or closed poliline)?

January 14, 2010

Good Job, Lee...'-)

Thanks Wiz

Is there any easy way to change a2f routine (by Lee) to be able to select only hatch (not circle or closed poliline)?

Blimey... picky lol

January 14, 2010

Try this:

(defun c:a2f (/ *error* Stringify ENT OBJ PT TMP TOBJ TYP UFLAG)
 ;; Lee Mac  ~  13.01.10
 (vl-load-com)

 (defun *error* (msg)
   (and uFlag (vla-EndUndoMark *doc*))
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **")))
   (princ))
 

 (defun Stringify (x / typ)
   (cond (  (eq 'REAL (setq typ (type x)))
            (rtos x))
         (  (eq 'INT typ)
            (itoa x))
         (  (eq 'STR typ) x)
         (t (vl-princ-to-string x))))
 

 (setq *doc* (cond (*doc*) ((vla-get-ActiveDocument
                              (vlax-get-acad-object))))

       *spc* (cond (*spc*) ((if (zerop (vla-get-activespace *doc*))
                              (if (= (vla-get-mspace *doc* :vlax-true))
                                (vla-get-modelspace *doc*)
                                (vla-get-paperspace *doc*))
                              (vla-get-modelspace *doc*)))))

 (or *a2f_Uni (setq *a2f_Uni 2))
 (or *a2f_Pre (setq *a2f_Pre 3))
 (or *a2f_Con (setq *a2f_Con 1.))
 (or *a2f_Hgt (setq *a2f_Hgt (getvar 'TEXTSIZE)))
 (or *a2f_Rot (setq *a2f_Rot 0.))
 (or *a2f_Suf (setq *a2f_Suf "m2"))

 (mapcar (function set) '(*a2f_Uni *a2f_Pre *a2f_Con *a2f_Hgt *a2f_Rot *a2f_Suf)
         (mapcar
           (function
             (lambda (ini foo msg x)
               (and ini (initget ini))
               (cond ((and (setq tmp ((eval foo) (strcat "\n" msg " <" (Stringify x) "> : ")))
                           (/= "" tmp)) tmp)
                     (x))))
            
            (list 6 4 6 6 nil nil)
           '(GetInt GetInt GetReal GetDist GetAngle GetString)
           '("Specify Units" "Specify Precision" "Specify Conversion Factor"
             "Specify Text Height" "Specify Text Rotation" "Specify Suffix")
            (list *a2f_Uni *a2f_Pre *a2f_Con *a2f_Hgt *a2f_Rot *a2f_Suf)))
           
 (while
   (progn
     (setq ent (car (entsel "\n>> Pick Hatch [And don't you dare pick anything else]  >>")))

     (cond (  (eq 'ENAME (type ent))

              (if (and (eq "AcDbHatch" (vla-get-ObjectName (setq obj (vlax-ename->vla-object ent))))
                       (vlax-property-available-p obj 'Area))
                
                (if (setq pt (getpoint "\nPick Point for Field: "))
                  (progn
                    (setq uFlag (not (vla-StartUndoMark *doc*)))

                    (setq tObj
                      (vla-AddMText *spc* (vlax-3D-point pt) 0.0
                        (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                                (vl-princ-to-string (vla-get-ObjectId obj))
                                ">%).Area \\f \"%lu" (itoa *a2f_Uni) "%pr"
                                (itoa *a2f_Pre) "%ps[," *a2f_Suf "]%ct8[" (rtos *a2f_Con) "]\">%")))

                    (mapcar
                      (function
                        (lambda (property value)
                          (vlax-put-property tObj property value)))

                      '(Height Rotation Layer Color)
                       (list *a2f_Hgt *a2f_Rot (vlax-get-property obj 'Layer)
                                               (vlax-get-property obj 'Color)))

                    (setq uFlag (vla-EndUndoMark *doc*))

                    t) ;; repeat

                  )

                (princ "\n** Invalid Object Selected **"))))))
 (princ))

January 14, 2010

And don't you dare pick anything else

this will help me a LOT!!!

Thanks all you guys for your effort!

January 14, 2010

this will help me a LOT!!!

Thanks all you guys for your effort!

You're welcome Tom

July 1, 2013

@ Mr.Lee

The code on post #45 sounds good for me.

But I need change the formula of the code. Instead of sum , I need divide the objects.

e.g

((158494.64/658900.44)*100)= 24.05

Thank in advance.

Regards

March 9, 2022

On 1/12/2010 at 10:01 PM, Lee Mac said:

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

Can you please update for me for replace select point to select text

Sign In

Sum Text Strings to Text Field...

Recommended Posts

Lee Mac

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

Lee Mac

wizman

Lee Mac

Posted Images

Lee Mac

tomjas

Lee Mac

Lee Mac

tomjas

gile

Lee Mac

tomjas

Lee Mac

tomjas

Lee Mac

wizman

tomjas

Lee Mac

Lee Mac

tomjas

Lee Mac

Madruga_SP

Chetan

Join the conversation

Lee Mac

wizman

Lee Mac

Tutorials

Forums

Activity