[编程交流] 填充多个块属性

; pick a block and enter attributes into table
; by Alan H April 2017
(defun c:blk-tab ( / tabrows lst lst2 lstatt x )
(if (/= tblobj nil)
(princ)
(setq tblobj (vlax-ename->vla-object (car (entsel "Pick table"))))
)
(setq tabrows (vla-get-rows tblobj)) ; number of rows existing
; if has attribs check here
(while (setq obj (vlax-ename->vla-object (car (entsel "Pick Block"))))
(setq lst '())
(setq lstatt '())
(foreach att (vlax-invoke obj 'getattributes)
(setq lstatt (cons (vla-get-textstring att) lstatt))
(setq lst (cons (strcat (vla-get-tagstring att) " " (vla-get-textstring att)) lst))
(setq lst (cons 4 lst))
(setq lst (cons 2 lst))
)
(setq lst (reverse lst))
(setq lstatt (reverse lstatt))
(if (not AH:getkeys)(load "getvals2"))
;(AH:getkeys (list "Line 1" 5 4 "line 2" 4 2 "line 3" 8 7))
(princ "\nGetvals2 loaded")
(AH:getkeys lst)
; get key values as a list
(setq num (/ (length lst) 3))
(setq x 1)
(setq lst2 '())
(repeat num 
(setq lst2 (cons (atoi (eval (read (strcat "Key" (rtos x 2))))) lst2))
(setq x (+ x 1))
)
(setq lst2 (reverse lst2)) ; this is the order for table matches nth lstatt
; now do table insertion this is column values for next entry
; add a row then insert values.
(vla-InsertRows tblobj (+ tabrows 1) (vla-GetRowHeight tblobj (- tabrows 1)) 1)
(repeat (setq x (length lstatt))
(setq x (- x 1))
(vla-settext tblobj tabrows  (- (nth x lst2) 1) (nth x lstatt)) ;1st column is zero
)
(setq tabrows (+ tabrows 1))
) ;while
(setq ans (getstring "To reset table just press <Cr> any other key to continue "))
(if (= ans nil)(setq tblobj nil))  
) ;defun

; example of creating a table
; By Alan H
(defun c:sct (/ colwidth numcolumns numrows objtable rowheight sp vgad vgao )
(vl-load-com)
(setq sp (vlax-3d-point '(0 0 0)))
(setq doc  (vla-get-activedocument (vlax-get-acad-object) ))
(setq vgms (vla-get-modelspace doc))
(setq numrows 5)
(setq numcolumns 5)
(setq rowheight 0.5)
(setq colwidth 30)
(setq objtable (vla-addtable vgms sp numrows numcolumns rowheight colwidth))
; RetVal = object.AddTable(InsertionPoint, NumRows, NumColumns, RowHeight, ColWidth)
(vla-settext objtable 0 0 "TABLE title")
(vla-settext objtable 1 0 "A") 
(vla-settext objtable 1 1 "B") 
(vla-settext objtable 1 2 "C")
(vla-settext objtable 1 3 "D")
(vla-settext objtable 1 4 "E")
(vla-settext objtable 2 0 "1")
(vla-settext objtable 3 0 "2")
(vla-settext objtable 4 0 "3")
(vla-setcolumnwidth objtable 0 15) ; 0 is first column
(vla-setcolumnwidth objtable 1 30)
(vla-setcolumnwidth objtable 2 60)
(command "_zoom" "e")
(princ)
)
(C:sct)

; multi line dcl
; with help from the guys at Cadtutor
; sample code a 3 line example
; (if (not AH:getkeys)(load "getvals2"))
;(AH:getkeys (list "Line 1" 5 4 "line 2" 2 4 "line 3" 8 7))
(princ "Getvals2 loaded")
(defun AH:getkeys (INFO / fo fname newlst num x y klist)
; you can hard code a directory if you like for dcl file
(setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
;(setq fo (open (setq fname "c:\\acadtemp\\getkeys.dcl") "w"))
(write-line "ddgetkey : dialog {" fo)
(write-line " : column {" fo)
(setq num (/ (length info) 3))
(setq x 1)
(repeat num
(setq klist (cons (strcat "key" (rtos x 2 0)) klist))
(setq x (+ 1 x))
)
(setq x 1)
(setq y 1)
(repeat num
(write-line ": edit_box {" fo)
(write-line (strcat "    key = "  (chr 34) (strcat "key" (rtos y 2 0)) (chr 34) ";") fo)
(write-line (strcat " label = "  (chr 34) (nth (- x 1) info) (chr 34) ";"  )   fo)
(write-line (strcat "     edit_width = " (rtos (nth x info) 2 0) ";" ) fo)
(write-line (strcat "     edit_limit = " (rtos (nth (+ x 1) info) 2 0) ";" ) fo)
(write-line "   is_enabled = true;" fo)
(write-line "  }" fo)
(write-line "spacer_1 ;" fo)
(setq x (+ x 3))
(setq y (+ y 1))
)
(write-line "  }" fo) 
(write-line "ok_only;}" fo)
(close fo)
(setq x 1)
(setq outlst '())
(setq dcl_id (load_dialog  fname))
(if (not (new_dialog "ddgetkey" dcl_id))
(exit))
(foreach k klist
     (action_tile k (strcat "(setq " k " (get_tile "" k ""))"))
)
 (action_tile "accept" "(done_dialog 1)")
 (action_tile "cancel" "(done_dialog 0)")
 (setq action (start_dialog))
 (unload_dialog dcl_id)
) ; defun