Length to field in attrubute

[djurk_haas]

Hello,

The lisp "Areas2AttributeV1-2" from Lee Mac works great but of course I want some extra things:

- What do I have to adjust so that is would do the same for the lenght of polyline(s) instead of area?

- Is it possible to do both, area and length, at the same time? So I select a polyline and then it will put the area to an fixed attribute (VLOEROPP) and the length to an fixed attribute (OMTREK). So you don't have to choose anymore wich attribute you want to be modidfied.

Thanks in advance

[ВeekeeCZ · Accepted solution]

Try this.

(vl-load-com)

(defun c:RoomDims (/ atts i obj pl blk)

  (while (and (setq pl (car (entsel "\nSelect polyline <exit>: ")))
              (or (wcmatch (cdr (assoc 0 (entget pl))) "ARC,CIRCLE,ELLIPSE,HATCH,*POLYLINE,REGION,SPLINE")
                  (prompt "\nWrong selection, need ARC,CIRCLE,ELLIPSE,HATCH,*POLYLINE,REGION,SPLINE."))
              (setq blk (car (entsel "\nSelect block: ")))
              (or (= "INSERT" (cdr (assoc 0 (entget blk))))
                  (prompt "\nWrong select, need block."))
              (setq obj (vlax-ename->vla-object blk))
              (setq atts (vlax-invoke obj "GetAttributes"))
              )
    (foreach att atts
      (cond ((= (vla-get-tagstring att) "VLOEROPP")
             (vla-put-textstring att (strcat
                                       "%<\\AcObjProp Object(%<\\_ObjId "
                                       (LM:objectid (vlax-ename->vla-object pl))
                                       ">%).Area \\f \"" "%lu2%pr1%ct8[1.000000000000000E-006]" "\">%" ))
             (vl-cmdf "_.updatefield" (vlax-vla-object->ename att) ""))
            
            ((= (vla-get-tagstring att) "OMTREK")
             (vla-put-textstring att (strcat
                                       "%<\\AcObjProp Object(%<\\_ObjId "
                                       (LM:objectid (vlax-ename->vla-object pl))
                                       ">%).Length \\f \"" "%lu2%pr1%ct8[1.000000000000000E-003]" "\">%" ))
             (vl-cmdf "_.updatefield" (vlax-vla-object->ename att) "")))))
  (princ)
  )


(defun LM:objectid ( obj )
  (eval
    (list 'defun 'LM:objectid '( obj )
          (if (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
            (if (vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring)
              (list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
              '(LM:ename->objectid (vlax-vla-object->ename obj))
              )
            '(itoa (vla-get-objectid obj))
            )
          )
    )
  (LM:objectid obj)
  )

;; Entity Name to ObjectID  -  Lee Mac
;; Returns the 32-bit or 64-bit ObjectID for a supplied entity name

(defun LM:ename->objectid ( ent )
  (LM:hex->decstr
    (setq ent (vl-string-right-trim ">" (vl-prin1-to-string ent))
          ent (substr ent (+ (vl-string-position 58 ent) 3))
          )
    )
  )

;; Hex to Decimal String  -  Lee Mac
;; Returns the decimal representation of a supplied hexadecimal string

(defun LM:hex->decstr ( hex / foo bar )
  (defun foo ( lst rtn )
    (if lst
      (foo (cdr lst) (bar (- (car lst) (if (< 57 (car lst)) 55 48)) rtn))
      (apply 'strcat (mapcar 'itoa (reverse rtn)))
      )
    )
  (defun bar ( int lst )
    (if lst
      (if (or (< 0 (setq int (+ (* 16 (car lst)) int))) (cdr lst))
        (cons (rem int 10) (bar (/ int 10) (cdr lst)))
        )
      (bar int '(0))
      )
    )
  (foo (vl-string->list (strcase hex)) nil)
  )

;; Active Document  -  Lee Mac
;; 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)
  )