;|----------------------------------------------------------------------------|
| AutoCAD çizim ekranından seçilerek belirlenen bir BLOCK altında yer alan   |
| ATTRIBUTE nesnelerinin değerleri, MS EXCEL uygulaması etkin durumda ise,   |
| bu dosyaya yeni bir çalışma sayfası eklenerek, MS EXCEL uygulaması etkin   |
| durumda değilse, yeni bir oturum açılarak, ilk çalışma sayfasına yazılır.  |
|                www.cizimokulu.com  M. Şahin Güvercin (ProhibiT) 15-07-2015 |
|____________________________________________________________________________|;
(defun c:AtEx (/ *error* AtR Books EbL ExB ExceLApp ExCeLLs n NewBook PaT PvT
               rn Sheet1 Sheets sTn sTr VaL)
  (vl-load-com)
  (setq ocmd (getvar "cmdecho") odz (getvar "dimzin") atd (getvar "attdia"))
  (defun *error* (er /)
    (if (= (logand (getvar "undoctl") 8) 8) (command-s "_.undo" "e"))
    (if ocmd (setvar "cmdecho" ocmd)) (if odz (setvar "dimzin" odz))
    (if atd (setvar "attdia" atd)) (if er (princ (strcat "\n" er))) (prin1))
  (setvar "cmdecho" 0) (command "_.undo" "group") (setvar "dimzin" 0)
  (while (not ExB) (princ "\r Attribute Export edilecek Block'u seçiniz.")
    (setq ExB (ssget ":s" (list (cons 0 "INSERT")))
          ExB (cdr (assoc 2 (entget (ssname ExB 0)))))
    (if (/= (cdr(assoc 70 (entget(tblobjname "Block" ExB)))) 2)(setq ExB nil)))
  (setq ExceLApp (vlax-get-or-create-object "Excel.Application"))
  (if (setq NewBook (vlax-get-property ExceLApp "ActiveWorkbook"))
    (setq Books  (vlax-get-property ExceLApp "Workbooks")
          Sheets (vlax-get-property NewBook "Sheets")
          Sheet1 (vlax-invoke-method Sheets "Add"))
    (setq Books   (vlax-get-property ExceLApp "Workbooks")
          NewBook (vlax-invoke-method Books "Add")
          Sheets  (vlax-get-property NewBook "Sheets")
          Sheet1  (vlax-get-property Sheets "Item" 1)))
  (setq ExCeLLs (vlax-get-property Sheet1 "Cells"))
  (vlax-put-property ExceLApp "UseSystemSeparators" :vlax-false)
  (vlax-put-property ExceLApp "DecimalSeparator" ".")
  (vlax-put-property ExceLApp "ThousandsSeparator" " ")
  (vla-put-visible ExceLApp :vlax-true)
  (setq PvT (tblobjname "Block" ExB) sTn 0 sTr 1)
  (while (setq PvT (entnext PvT))
    (if (= (cdr (assoc 0 (entget PvT))) "ATTDEF")
      (progn (setq sTn (1+ sTn)
                   AtR (append AtR (list (cdr (assoc 2 (entget PvT))))))
     (vlax-put-property ExCeLLs "Item" sTr sTn (cdr (assoc 3 (entget PvT)))))))
  (setq EbL (ssget "x" (list (cons 0 "INSERT") (cons 2 ExB))) n -1)
  (while (< (setq n (1+ n)) (sslength EbL))
    (setq sTr (1+ sTr) PvT (ssname EbL n))
    (while (= "ATTRIB" (cdr (assoc 0 (entget (setq PvT (entnext PvT))))))
      (setq PaT (cdr (assoc 2 (entget PvT))) VaL (cdr (assoc 1 (entget PvT))))
      (vlax-put-property ExCeLLs "Item" sTr (1+ (vl-position Pat AtR)) VaL)))
  (setq rn (vlax-get-property ExCeLLs "Range"
             (vlax-variant-value (vlax-get-property ExCeLLs 'Item 1 1))
             (vlax-variant-value (vlax-get-property ExCeLLs 'Item sTr sTn))))
  (vlax-invoke-method (vlax-get-property rn 'Columns) 'AutoFit)
  (vlax-invoke-method (vlax-get-property rn 'Rows) 'AutoFit)
  (vlax-put-property (vlax-get-property rn 'Borders) 'Color
    (vlax-make-variant "0.0"))
  (vlax-put-property (vlax-get-property rn 'Borders) 'LineStyle
    (vlax-make-variant "1"))
  (vlax-put-property ExcelApp "UseSystemSeparators" :vlax-true)
  (mapcar 'vlax-release-object
          (list rn ExCeLLs Sheet1 Sheets NewBook Books ExcelApp))
  (setq ExcelApp nil) (gc) (gc)
  (if (= (logand (getvar "undoctl") 8) 8) (command-s "_.undo" "e"))
  (if odz (setvar "dimzin" odz)) (if atd (setvar "attdia" atd))
  (if ocmd (setvar "cmdecho" ocmd)) (prin1))