Message 1 of 14
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
HI
I have the attached Block and I was trying to modify the following code to extract the one Attribute, get the coordinates and create a table.
(defun c:<Test7 (/ *error* :sortlst acapp acol acsp adoc atable attdata attitem atts blkdata blkname blkobj col
column colwidth datalist en headers pt row ss swap tabledata tags total txtheight widths x)
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
(princ (strcat "\nError: " errmsg)))
(command-s "_.UCS" "_P")
(princ))
;; Lee Mac
;; http://www.lee-mac.com/attributefunctions.html
(defun LM:vl-getattributes ( blk )
(mapcar '(lambda (att) (cons (vla-get-tagstring att) (vla-get-textstring att)))
(vlax-invoke blk 'getattributes)))
;; 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 (and (wcmatch (getenv "PROCESSOR_ARCHITECTURE") "*64*")
(vlax-method-applicable-p (vla-get-utility (LM:acdoc)) 'getobjectidstring))
(list 'vla-getobjectidstring (vla-get-utility (LM:acdoc)) 'obj ':vlax-false)
'(itoa (vla-get-objectid obj)))))
(LM:objectid obj))
;; 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))
; ----------------------------------------------------------------------------------------------------------------------------
; ----------------------------------------------------------------------------------------------------------------------------
(command "_.UCS" "_W")
(setq flt "SPI-Datenextraktionspunkt-CM*")
(if (setq ss (ssget (list '(0 . "INSERT") (cons 2 flt) '(66 . 1))))
(progn
(repeat (setq i (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq i (1- i))))
tabledata (cons (LM:vl-getattributes obj) tabledata)))
(setq tabledata (vl-remove nil tabledata)
headers (mapcar 'car (car tabledata))
tags headers
tabledata (mapcar '(lambda (x) (mapcar 'cdr x))
tabledata))
;; sort by "A1" :
(setq tabledata (vl-sort tabledata '(lambda (a b)(< (car a)(car b)))))
(if (= tabledata nil)(progn (alert "Keine Daten gefunden!")(exit)))
(setq total 0)
(foreach i datalist (setq total (+ total (cdr i))))
(setq txtheight (if (= btog10 1)(* 15 0.01) 15))
(or adoc (setq adoc (vla-get-activedocument (setq acapp (vlax-get-acad-object)))))
(or acsp (setq acsp (vla-get-block (vla-get-activelayout adoc))))
(setq acCol (vla-GetInterfaceObject acapp(strcat "AutoCAD.AcCmColor." (itoa (atoi (getvar "acadver"))))))
(setq pt (getpoint (strcat "\n" Typ. " Tabelle einfügen:"))
atable (vla-addtable
acsp
(vlax-3d-point pt)
(+ 2 (length tabledata))
(length headers)
(* txtheight 1.2)
(* txtheight 20)))
(vla-put-regeneratetablesuppressed atable :vlax-true)
;; calculate column widths :
(setq swap (append (list headers) tabledata)
widths nil)
(while (car swap)
(setq column (mapcar 'car swap)
colwidth (* 1.2 (apply 'max (mapcar 'strlen column)) txtheight)
widths (cons colwidth widths)
swap (mapcar 'cdr swap)))
(setq widths (reverse widths))
;; set column widths
(setq col 0)
(foreach wid widths
(vla-setcolumnwidth atable col wid)
(setq col (1+ col)))
(vla-put-colorindex acCol 8)
(vla-setgridcolor atable 61 7 acCol)
(vla-put-horzcellmargin atable (* txtheight 0.5))
(vla-put-vertcellmargin atable (* txtheight 0.3))
(vla-setTextheight atable 1 (* txtheight 0.8))
(vla-setTextheight atable 2 (* txtheight 1.2))
(vla-setTextheight atable 4 (* txtheight 0.9))
(vla-setText atable 0 0 "Koordinaten")
(vla-SetCellAlignment atable 0 0 acMiddleCenter)
(vla-put-colorindex acCol 3)
(vla-setcellcontentcolor atable 0 0 acCol)
(setq col -1)
(foreach descr headers
(vla-SetTextStyle atable (+ acHeaderRow acDataRow acTitleRow) "Simplex7-12.5")
(vla-setText atable 1 (setq col (1+ col)) descr)
(vla-SetCellAlignment atable 1 col acMiddleCenter)
(vla-setcellcontentcolor atable 1 col acCol))
(vla-put-colorindex acCol 4)
(setq row 2)
(foreach record tabledata
(setq col 0)
(foreach item record
(vla-setText atable row col item)
(if (= 1 col)
(vla-SetCellAlignment atable row col acMiddleCenter)
(vla-SetCellAlignment atable row col acMiddleCenter))
(vla-setcellcontentcolor atable row col acCol)
(setq col (1+ col)))
(setq row (1+ row)))
(vla-put-width atable (apply '+ widths))
(vla-put-height atable (* 1.2 (vla-get-rows atable)txtheight))
(vla-put-regeneratetablesuppressed atable :vlax-false))
(progn (alert "Keine Objekte gewählt!")(exit)))
(command "_.UCS" "_P")
(if acCol (vlax-release-object acCol))
(if acapp (vlax-release-object acapp))
(princ)
)
The table I will get:
KoordNr. x y
001 000000,000 000000,000
002 000000,000 000000,000
003 000000,000 000000,000
Can you help me get to this?
BeekeeCZ: If you read this... Yes I was trying to modify your code from the last month :)...
Kind regards...
Solved! Go to Solution.
