Hi,
I had trouble about Addfields lisp by Gile and modified by Lee Mac.
That lisp insert a text field wich value is the sum of selected field.
The sum didn't work properly. It's happened because of the precision of a decimal units.
And my project didn't aproved because of 0.01mē.
The attached file explain better my task.
Could you please, help me?
Thank in advance
;; 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)
)
)
