Sum Text Strings to Text Field...

[Lee Mac]

Good Code Gile, thanks,

 

Agreed...

[tomjas]

Another hero

 

I think I know where is a problem. First routine (fArea.vlx) creates labels with field and text 'm2' or whatever user will type. And this 'm2' is not a suffix- is a text. So if somebody can create routine which will do the same (measure area of selected object) with proper suffix (maybe asking user to define one)- then the last code from gile will work perfectly, reading precission, format, suffix). I need to start looking for some lsp tutorials... you guys are doing magic!

[wizman]

good! we have another recruit..

[wizman]

Haha not a chance mate...

 

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

 

 

 

(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>%\)>%" " +")))

working but will not be updating the new total area when changed because of the if statement inside diesel.

[Lee Mac]

Am I right in saying that you only changed the quotation marks in m2?

[wizman]

i think last line also lee, be back tomorrow..'-)

[wizman]

Another hero

 

I think I know where is a problem. First routine (fArea.vlx) creates labels with field and text 'm2' or whatever user will type. And this 'm2' is not a suffix- is a text. So if somebody can create routine which will do the same (measure area of selected object) with proper suffix (maybe asking user to define one)- then the last code from gile will work perfectly, reading precission, format, suffix). I need to start looking for some lsp tutorials... you guys are doing magic!

 

Please try:

 

;; Area to Field
;;
(defun c:AField (/ fp_ent fp_vla_id)
   (vl-load-com)
   (if (and
           (setq fp_ent (car (entsel ">>>...Pick Hatch or Closed Polyline ...>>>")))
           (setq fp_vla_id (vla-get-objectid (vlax-ename->vla-object fp_ent)))
       ) ;_ end_and
       (progn
           (vla-put-TextString
               (vlax-ename->vla-object
                   (car
                       (nentsel
                           "\n>>>...Pick Attribute or Text to Place Linked Area...>>>: "
                       )
                   )
               )
               (strcat
                   "%<\\AcObjProp Object(%<\\_ObjId "
                   (itoa fp_vla_id)
                   ">%).Area                           
	    \\f \"%lu2%ps[,m2]\">%"
               )
           )
       )
   )
   (princ)
)
;;
;;WIZ_13JAN10

[tomjas]

Good morning!

 

I can see that you couldn’t sleep.

 

Thank you very much for your effort. I’m really appreciating it!

 

Wizman:

Thank you for Afield code!

 

 

Is it possible to (AField):

-Create new text label, rather than selecting existing text or attribute (in this case we need to ask user for start point, text height and rotation angle). Or maybe ask user to set the text height and rotation angle for the whole routine only once, and then ask user only for start point of new label.

-Match properties of selected object – layer, colour. If they will be on the same layer as a selected object, than I can easily isolate them and change ie. Text style

-Create like a setup option where user can specify suffix, multiplication factor (if they have a dwg in m2 but want areas in ha), display precision (I can’t see where to change this in code) and maybe as I ask in first bullet point: text height and rotation angle.

 

 

 

 

Code created by gile:

 

- can new label match the layer and colour of the last selected object too

 

I know I’m asking for a lot, but:

-I’m working with some ‘cad users’, and most of them don’t know how to set colour of the object to ‘by layer’, so you can imagine if I’ll ask them to use Quick Select tool to isolate text and change properties…

-You guys are the first ones who is doing this and publishing in web (I’ve spent 7h searching for this sort of lsp- what I’m going to put in my timesheet??)

-is a challenging task

-you guys are great

[wizman]

Here's a quick one:

 

;; Area to Field
;;
(defun c:AField (/ af_ent af_mtx af_pt af_vla_id tmp prec units dtr)
   ;;
   (vl-load-com)
   ;;
   (defun dtr (var)
       (* PI (/ var 180.0))
   )
   ;;
   (setq Units 2 Prec 3)
   ;;
   (if
       (and
           (setq af_ent
                    (car
                        (entsel ">>>...Pick Hatch, Circle or Closed Polyline ...>>>"
                        )
                    )
           )
           (setq af_ent (vlax-ename->vla-object af_ent))
       )

          (cond
              ((or
                   (= (vlax-get-property af_ent 'ObjectName) "AcDbCircle")
                   (= (vlax-get-property af_ent 'ObjectName) "AcDbPolyline")
                   (= (vlax-get-property af_ent 'ObjectName) "AcDbHatch")
               )
               (progn
                   ;;
                   (or af_def_ht (setq af_def_ht 1.))
                   (or af_def_rot (setq af_def_rot 0.))
                   (or af_def_suf (setq af_def_suf "m2"))
                   ;;
                   (setq af_vla_id  (vla-get-objectid af_ent)
                         af_def_lay (vla-get-layer af_ent)
                   )
                   (and (setq tmp (getreal (strcat "\nSpecify Text Height <" (rtos af_def_ht) ">: ")))
                        (setq af_def_ht tmp)
                   )
                   (and (setq tmp
                                 (getreal (strcat "\nSpecify Text Rotation <" (rtos af_def_rot) ">: "))
                        )
                        (setq af_def_rot tmp)
                   )
                   (setq tmp (getstring (strcat "\nSpecify Text Suffix <" af_def_suf ">: ")))
                   (if (/= "" tmp)
                       (setq af_def_suf tmp)
                   )
                   ;;
                   (setq af_pt (getpoint "\n>>>...Pick Text Insertion Point...>>>"))
                   ;;
                   (setq af_mtx
                            (vla-addMText
                                (vla-get-MODELspace
                                    (vla-get-ActiveDocument
                                        (vlax-get-acad-object)
                                    )
                                )
                                (vlax-3d-point af_pt)
                                0.0
                                (strcat
                                    "%<\\AcObjProp Object(%<\\_ObjId "
                                    (itoa af_vla_id)
                                    ">%).Area \\f \"%lu"
                                    (itoa units)
                                    "%pr"
                                    (itoa Prec)
                                    "%ps[,"
                                    af_def_suf
                                    "]\">%"
                                )
                            )
                   )
                   (vlax-put af_mtx 'height af_def_ht)
                   (vlax-put af_mtx 'rotation (dtr af_def_rot))
                   (vlax-put af_mtx 'layer af_def_lay)
               )
              )
              (t nil)
          )
   )
   (princ)
)
;;
(prompt
   "\n>>>...AFIELD.Lsp is Now Loaded.  Type 'AF' or 'Afield' to Start Command...<<<\n"
)
(defun c:af () (c:afield))
(princ)
;;
;;WIZ_13JAN10

[tomjas]

WOW

 

Working great!

 

Can you just point me what needs to be changed in code to set the accuracy, please?

Previously was quite simple (setq Units 2 Prec 3) but since you just 'jump' to 'next' level I have no idea. Or maybe user can define accuracy ?

 

once again thanks

[wizman]

I update the code above, now with precision..'-)

[tomjas]

Thank you!!!!!!!!!!!!!!!

[Lee Mac]

An alternative approach :wink:

 

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

 (setq Units 2 Prec 3) ;; Accuracy
 

 (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_Hgt (setq *a2f_Hgt (getvar 'TEXTSIZE)))
 (or *a2f_Rot (setq *a2f_Rot 0.))
 (or *a2f_Suf (setq *a2f_Suf "m2"))

 (mapcar (function set) '(*a2f_Hgt *a2f_Rot *a2f_Suf)
         (mapcar
           (function
             (lambda (foo msg x)
               (cond ((and (setq tmp ((eval foo) (strcat msg " <" (Stringify x) "> : ")))
                           (/= "" tmp)) tmp)
                     (x))))

           '(GetDist GetAngle GetString)
           '("Specify Text Height" "Specify Text Rotation" "Specify Suffix")
            (list *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 Units) "%pr" (itoa Prec) "%ps[," *a2f_Suf "]\">%")))

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

                   

[tomjas]

This is great Lee as you don't have to type text height, rotation and suffix each time (or pressing enters)- set values once and then selecting object and placing label = great!!!

 

I've tried change the wiz code to force user to define precision without any success

Can you add option to set the precission on the beginig as you did for text height, rotation and suffix, please?

 

And I'm in heaven

 

Thanks

[Lee Mac]

You're welcome

 

(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_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_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 nil nil)
           '(GetInt GetInt GetDist GetAngle GetString)
           '("Specify Units" "Specify Precision"
             "Specify Text Height" "Specify Text Rotation" "Specify Suffix")
            (list *a2f_Uni *a2f_Pre *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 "]\">%")))

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

[tomjas]

THANKS

 

All sorted!

 

I need to change gile code to match layer properties of last selected object, and find the way of asking for conversion factor (in your code) and then I can explain how to use it to our 'cad users'. Or maybe adding conversion factor option is a 10sec job for you and maybe 5sec job to change gile code to match layer+layer colour of last selected object? PLEASE

 

And one additional question: is it my task a challenging one? or you guys are doing more complicated tasks before going to bed each day?

 

thanks

[Lee Mac]

And one additional question: is it my task a challenging one? or you guys are doing more complicated tasks before going to bed each day?

 

To be honest, no, this part is not too difficult, the field code does all the work, but I just like to code it in more interesting ways

[Lee Mac]

Gile's code modified (go easy on me Gile..)

 

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

;; Slightly Modified by Lee Mac

(defun c:AddFields (/ *error* ent lst res code pos ins first_obj tObj)
 (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: ")))
   (or first_Obj (setq first_Obj (vlax-ename->vla-object ent))) ;; Lee Mac
   (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)

     ;; Lee Mac's Modification
     (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 first_obj x))))

       '(Layer Color))

     ;; End of Modification
   )
 )
 (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)
 )
)

[Lee Mac]

and find the way of asking for conversion factor (in your code)

 

What do you mean by this?

[tomjas]

I meant another option to ask user for conversion factor as you asking for text height, rotation, angle, units type, precision...

 

ie. dwg is in meters but they want labels in ha, so changing suffix is simple (now ) but if you will set the conversion factor to 0.0001, then label will return area in hectares.

 

If you will insert field, fields category: objects, select object, area, format, precision, than there is that extra button: Additional Format:

and you can set the conversion factor there...