[编程交流] 具有属性的动态块

;;************************************************************
;; Design by Gabo CALOS DE VIT from CORDOBA ARGENTINA
;;;    Copyleft 1995-2009 by Gabriel Calos De Vit 
;; DEVITG@GMAIL.COM
;;-*******************************************************************************************************************************
(DEFUN guarda-lista-csv-w  (lista
                           /
                           ar
;;;                            nombre-archivo
                           )
 (SETQ nombre-archivo
        (STRCAT (GETVAR "dwgprefix")
                (VL-FILENAME-BASE (GETVAR "dwgname"))
                ".csv"))
 (SETQ ar (OPEN nombre-archivo "w"))
 (FOREACH texto  lista
   (WRITE-LINE texto ar)
   )
 (CLOSE ar)
 )
;;-*******************************************************************************************************************************
;;;---------------------------------------------------------------------------------------------------------
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/
;;;Juerg Menzi
;;;MENZI ENGINEERING GmbH, Switzerland
;;;http://www.menziengineering.ch
; == Function MeGetAtts
; Reads all attribute values from a block
; Arguments [Typ]:
;   Obj = Object [VLA-OBJECT]
; Return [Typ]:
;   > Dotted pair list '(("Tag1" . "Val1")...)
[list]
; Notes:
;   None
;
(defun MeGetAtts (Obj)
 (mapcar
 '(lambda (Att)
   (cons
    (vla-get-TagString Att)
    (vla-get-TextString Att)
   )
  )
  (vlax-invoke Obj 'GetAttributes)
 )
)
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*
;; TASK TO DO 
;;;Export all the attributes
;;;+handle id of the blocks
;;;+visibility state
;;;+Real blockname
(defun GET-NAME+HANDLE+VISIBLE+ATTs ( /
                 ACAD* ADOC ALL-INSERTED-CSV-LIST ALL-INSERTED-DATA-LIST ATT-PAIR-LIST CSV-LIST DATA-LIST DATA-LIST< HANDLE nombre-archivo INSERTED-CSV INSERTED-LIST INSERTED-SS NAME VISIBLE
               )
(vl-load-com)
(setq acad* (vlax-get-acad-object)) ;_ ACAD 
(setq adoc (vla-get-activedocument acad*))  ;_ DWG active 
(setq insertED-SS (ssget "_X" '(( 0 . "insert"))));_ all inserted blocks
(setq inserted-list (mapcar 'vlax-ename->vla-object (vl-remove-if-not '(lambda(x)(= (type x) 'ENAME)) (mapcar 'cadr (ssnamex insertED-SS)))));_ a list of inserted
(setq all-inserted-csv-list nil)
(setq all-inserted-data-list nil)  
(foreach inserted inserted-list
(setq data-list nil)
(setq csv-list nil)
(setq name (vla-get-EffectiveName inserted))
(setq data-list (cons (cons "NAME" name) data-list))
(setq handle (vla-get-Handle  inserted))
(setq data-list (cons (CONS "HANDLE"  handle) data-list))
 
(setq visible (if  (vla-get-Visible inserted) 
 "visible"
 "no visible"
   );_ if 
     );_ visible
(setq data-list (cons (cons "VISIBLE"  visible) data-list))
(setq csv-list (reverse(list name  handle visible ) ))
 (if (vla-get-hasAttributes inserted )
(progn    
(setq att-pair-list  (MeGetAtts inserted))
(foreach att-pair att-pair-list
  (setq data-list ( cons att-pair data-list))
  (setq csv-list (cons (Cdr att-pair) csv-list))
 )
);_ progn
   );If has attribute 
 
(setq inserted-csv (list$2cvs (reverse csv-list)))
(setq data-list<  (reverse data-list))
 
(setq all-inserted-data-list (cons  data-list< all-inserted-data-list))
(setq all-inserted-csv-list (cons  inserted-csv all-inserted-csv-list))
);_ foreach inserted
(setq blk-qty (length all-inserted-csv-list))
 
(guarda-lista-csv-w all-inserted-csv-list)
 (alert (strcat "\n Data form  : \n " (Itoa blk-qty) "   BLOCKS  \n has been sent to .. \n" nombre-archivo ))
 (princ)
);_ defun 
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*
(defun c:dyn-dat ()
 (GET-NAME+HANDLE+VISIBLE+ATTs)
 
 )
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/
(defun list$2cvs (#lst)
(if (not ( listp #lst))
(setq #lst (list #lst))
)
(apply 'strcat
(cons (car #lst)
(mapcar '(lambda (str) (strcat "," str))
(cdr #lst)
) ;_mapcar
) ;_cons
) ;_apply
) ;_ string-list2cvs
;;;usage(string-list2cvs '("One" "Two" "Three"))
;;;->"One,Two,Three"
;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/
(prompt "prompt DYN-DAT at the command line")
;|«Visual LISP© Format Options»