Message 1 of 5
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello,
I have been fiddling around with this code for the past few days now.
Starting from Lee Mac Area 2 field code I've learned a thing or two.
I've managed to get all the values but using LM:vl-setattributevalues seem to fail. I'm probably missing type of variables.
I need the routine to do te following:
- User picks a roomnumber from the xref
- user picks the shape or hatch
- user needs to give a height of the room
- user picks a place to put the block
- script calculates the volume based on hatch and height
- OPP and vol has to be tied to the area of the shape with a textfield for when someone changes the shape.
The goal is to do an attribute export of the block supplied by expresstools.
see files supplied. Files removed.
using acad 2017 and 2019 if it helps.
Thanks in advance.
(vl-load-com)
(defun c:RoomV ( / *error* sv_lst sv_vals fmt_A OPP area RNUM ht FCH vol att sel o ip)
(setq sv_lst (list 'attdia 'attreq) ; setup up list with variable
sv_vals (mapcar 'getvar sv_lst) ; save settings in list
);end setq
(setq fmt_A "%lu2%pr1%ps[,m2]%ct8[1.000000000000000E-006]" ;; area formatting
fmt_V "%lu2%pr1%ps[,m3]%ct8[1.000000000000000E-009]" ;; volume formatting
)
(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(while (setq RNUM (vlax-get-property (vlax-ename->vla-object (car (nentsel "\nSelect Room number from Xref: "))) 'textstring))
(and
(progn
(setq sel (ssget "_+.:S:E" '((0 . "ARC,CIRCLE,ELLIPSE,HATCH,*POLYLINE,REGION,SPLINE")))
ht (getreal "\nHeight of Area [mm]: ")
FCH (rtos ht)
ip (getpoint "\nPick insertion point for block \'ROOM_Volume\'")
)
)
)
; when everything is defined do:
(mapcar 'setvar sv_lst (list 0 0)); turn off attribute dialog window
(setq area (strcat "%<\\AcObjProp Object(%<\\_ObjId " (LM:objectid (vlax-ename->vla-object (ssname sel 0))) ">%).Area>%")
OPP (strcat "%<\\AcObjProp Object(%<\\_ObjId " (LM:objectid (vlax-ename->vla-object (ssname sel 0))) ">%).Area \\f \"" fmt_A "\">%")
vol (strcat "%<\\AcObjProp Object(%<\\_ObjId " (* area ht) ">%) \\f \"" fmt_V "\">%") ;(* area FCH)
)
(princ (strcat "\n" RNUM "\n"))
(command-s "_.-insert" "ROOM_Volume" ip "1" "" "0" "\n")
(setq attlst '(
("AREA" . area )
("RNUM" . RNUM )
("OPP" . OPP )
("FCH" . FCH )
("AT_VOL" . vol )
)
)
(setq o (vlax-ename->vla-object (entlast)))
(LM:vl-setattributevalues o attlst )
)
(mapcar 'setvar sv_lst sv_vals) ; Restore attribute dialog window
(princ)
)
;; ObjectID - Lee Mac
;; Returns a string containing the ObjectID of a supplied VLA-Object
;; Compatible with 32-bit & 64-bit systems
(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)
)
;; Start Undo - Lee Mac
;; Opens an Undo Group.
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
;; End Undo - Lee Mac
;; Closes an Undo Group.
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;; 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)
)
;; Get Attribute Value VL - Lee Mac
;; Returns the value held by the specified tag within the supplied block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; Returns: [str] Attribute value, else nil if tag is not found.
(defun LM:vl-getattributevalue ( blk tag )
(setq tag (strcase tag))
(vl-some '(lambda ( att ) (if (= tag (strcase (vla-get-tagstring att))) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)
;; Set Attribute Value VL - Lee Mac
;; Sets the value of the first attribute with the given tag found within the block, if present.
;; blk - [vla] VLA Block Reference Object
;; tag - [str] Attribute TagString
;; val - [str] Attribute Value
;; Returns: [str] Attribute value if successful, else nil.
(defun LM:vl-setattributevalue ( blk tag val )
(setq tag (strcase tag))
(vl-some
'(lambda ( att )
(if (= tag (strcase (vla-get-tagstring att)))
(progn (vla-put-textstring att val) val)
)
)
(vlax-invoke blk 'getattributes)
)
)
;; Get Attribute Values VL - Lee Mac
;; Returns an association list of attributes present in the supplied block.
;; blk - [vla] VLA Block Reference Object
;; Returns: [lst] Association list of ((<tag> . <value>) ... )
(defun LM:vl-getattributevalues ( blk )
(mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att))) (vlax-invoke blk 'getattributes))
)
;; Set Attribute Values VL - Lee Mac
;; Sets attributes with tags found in the association list to their associated values.
;; blk - [vla] VLA Block Reference Object
;; lst - [lst] Association list of ((<tag> . <value>) ... )
;; Returns: nil
(defun LM:vl-setattributevalues ( blk lst / itm )
(foreach att (vlax-invoke blk 'getattributes)
(if (setq itm (assoc (vla-get-tagstring att) lst))
(vla-put-textstring att (cdr itm))
)
)
)
;;----------------------------------------------------------------------;;
(vl-load-com)
(princ
(strcat
"\n:: Type \"RoomV\" to Invoke ::"
)
)
(princ)
Solved! Go to Solution.
