[討論]資料萃取屬性圖塊資料

各位大大好
小弟使用資料萃取屬性圖塊資料，萃取後因資料很多，在EXCEL編輯都要移來移去，把相同的又要放在一起做彙整，整理EXCEL表格時間過長，小弟想問有沒有比較好的方式處裡，能不能以我要的格式下去萃取，附上CAD圖與EXCEL表格，請各位大大指導，謝謝。
cad圖
excel表

這個資料真的很複雜！
剛剛試過簡單幾個萃取，以下為AutoCAD的表格結果，表格規格好像是既定的。


你是想要萃取出來就如同EXCEL，這部份好像沒有辦法，可能需要再到EXCEL後至處理～

我想玩玩看這個LISP程式~!
不知道Tanya還有沒有需求呢??還是說已經有其他程式可以替代了?
我看總圖裡面總共有十八種圖塊...是每一總圖塊的資訊都要會出嗎?

找一下舊資料有一篇圖塊屬性計算的lisp
不過是將表格直接繪製狂cad中不是傳到excel

感謝各位版大回復
我原本想法，是想要把CAD屬性圖塊資料，匯到固定EXCEL裡，依照EXCEL做的格式，因資料多，在CAD有時候會忘了打屬性，所以想在EXCEL打好後再上傳至CAD屬性圖塊裡，後來找了一些資訊，發現我的想法太過天真了，哈哈。
leoneriol大大想挑戰的話，小弟給你加油加油，圖面18種屬性圖塊都要， 。

leoneriol 大大 你的後援加油團來了 加油加油....

可惜我的基礎還沒有學好 不然我也想試一下......

tarpon之前所發問的那一篇在高手回答時確實是可以讀到屬性 不過加入動態控制就會出現錯誤

在另一篇動態圖塊屬性lisp有高手分享抓取方式
在2006使用正常可抓到動態圖塊屬性
但在2008以上版本使用被告知為不明函數

感謝各位的鼓勵.....

adslwang 寫到:leoneriol 大大 你的後援加油團來了 加油加油....

可惜我的基礎還沒有學好 不然我也想試一下......

tarpon之前所發問的那一篇在高手回答時確實是可以讀到屬性 不過加入動態控制就會出現錯誤

adslwang有空有閒的話也可以試著玩玩看囉!
我功力也不是很高,用的也只是最笨的方法----一直翻書

以下是我目前的進度......

代碼:

(defun c:PrintATT2Excel()
  ;;;載入VLA
  (vl-load-com)
  (if (null MX-acos) (jinn-get-excel-lib))
  (jinn-creat-excel-sheet)
  (setq acadobj(vlax-get-acad-object))
  (setq dwgobj (vla-get-ActiveDocument acadobj))
  (setq mspace (vla-get-ModelSpace dwgobj))
  (setq blocksobj (vla-get-blocks dwgobj))
  ;;;取得 圖塊名稱list("blklist") 圖塊種類個數("blkn")
  (setq blklist nil)
  (vlax-for sobj blocksobj
    (setq blkn (vla-get-name sobj))
    (if (/= (substr blkn 1 1) "*")
        (setq blklist (cons (strcase blkn) blklist))
    )
  )
  ;;;取得 總圖塊數("nns") 圖塊list("blkss_list")
  (setq blknum_list nil blkss_list nil)
  (foreach blkn blklist
    (setq ss (ssget "x" (list '(0 . "INSERT") (cons 2 blkn))))
    (if ss
      (progn
        (setq  nns (itoa (sslength ss)))
    (setq str1 (strcat blkn "\t" nns))
        (setq blknum_list (cons str1 blknum_list))
    (setq blkss_list (cons (list blkn ss) blkss_list))
      )
    )
  )
  ;;;
  (foreach blkn blklist
    (setq ss (ssget "x" (list '(0 . "INSERT") (cons 2 blkn))))
    (setq i 0 j 0)
    ;;新增一個活頁簿中空白工作表單物件sheetobj,以便在各儲存格中動作
    (setq sheetobj (vlax-invoke-method (vlax-get-property XLobj 'Worksheets) 'Add))
    ;;建立工作表單中儲存格物件
    (setq cells (MX-get-cells sheetobj))
    ;;輸入圖塊名稱
    (setq ceobj (get-XL-cell sheetobj (+ i 1) (+ j 1)))
    ;;(put-cell-txtcolor 儲存格物件 對齊方式 文字顏色 字高 資料內容)
    (put-cell-txtcolor ceobj 3 1 12 blkn)
    ;;;建立表頭
    (setq att_obj_list (vlax-safearray->list
          (vlax-variant-value
          (vla-getattributes
            (vlax-ename->vla-object
              (ssname ss i)
              )))))
    (repeat (length att_obj_list)
      (setq att_TagString (vla-get-TagString (nth j att_obj_list)))
      (setq ceobj (get-XL-cell sheetobj (+ i 1) (+ j 2)))
      ;;(put-cell-txtcolor 儲存格物件 對齊方式 文字顏色 字高 資料內容)
      (put-cell-txtcolor ceobj 3 1 12 att_TagString)
      (setq j (1+ j))
      )
    ;;;填寫內容
    (repeat (sslength ss)
      (setq att_obj_list (vlax-safearray->list
           (vlax-variant-value
             (vla-getattributes
               (vlax-ename->vla-object
             (ssname ss i)
             )))))
      (setq j 0)
      ;;輸入序號
      (setq ceobj (get-XL-cell sheetobj (+ i 2) (+ j 1)))
      ;;(put-cell-txtcolor 儲存格物件 對齊方式 文字顏色 字高 資料內容)
    (put-cell-txtcolor ceobj 3 1 12 (+ i 1))
      (repeat (length att_obj_list)
   (setq att_TextString (vla-get-TextString (nth j att_obj_list)))
   (setq ceobj (get-XL-cell sheetobj (+ i 2) (+ j 2)))
   ;;(put-cell-txtcolor 儲存格物件 對齊方式 文字顏色 字高 資料內容)
   (put-cell-txtcolor ceobj 3 1 12 att_TextString)
   (setq j (1+ j))
   )
      (setq i (1+ i))
      )
    )
  )
;==============以下資料摘用於"翔虹AutoCAD技術中心"編著的書"AutoCAD程式設計"===============
;;;載入EXCEL應用程式資源庫檔案
(defun jinn-get-excel-Lib ()
  (setq office:dir "C:\\Program Files (x86)\\Microsoft Office\\")
  (cond
    ((setq exlib (findfile (strcat office:dir "office\\" "Excel8.olb"))))   
    ((setq exlib (findfile (strcat office:dir "office\\" "Excel9.olb"))))
    ((setq exlib (findfile (strcat office:dir "office\\" "Excel.exe"))))
    ((setq exlib (findfile (strcat office:dir "office10\\" "Excel.exe"))))
    ((setq exlib (findfile (strcat office:dir "office12\\" "Excel.exe"))))   
    (t (setq exlib nil))
  )
  (if exlib
    (vlax-import-type-library
        :tlb-filename        exlib
  :methods-prefix    "MX-"
  :properties-prefix    "MX-"
  :constants-prefix    "MX-"
    )
    (progn
      (setq office:dir "C:\\Program Files\\Microsoft Office\\")
      (cond
  ((setq exlib (findfile (strcat office:dir "office\\" "Excel8.olb"))))
  ((setq exlib (findfile (strcat office:dir "office\\" "Excel9.olb"))))
  ((setq exlib (findfile (strcat office:dir "office\\" "Excel.exe"))))
  ((setq exlib (findfile (strcat office:dir "office10\\" "Excel.exe"))))
  ((setq exlib (findfile (strcat office:dir "office12\\" "Excel.exe"))))
  (t (setq exlib nil))
  )
      )
    )
  (if exlib
    (vlax-import-type-library
        :tlb-filename        exlib
  :methods-prefix    "MX-"
  :properties-prefix    "MX-"
  :constants-prefix    "MX-"
    )
    (alert "Excel typelib 檔案不存在")
  )
)
;;;建立Excel應用程式物件&表單物件
(defun jinn-creat-excel-sheet()
  (setq XLobj (vlax-create-object "Excel.Application"))
    ;;將建立EXCEL 應用程式物件XLobj顯示出來
  (vla-put-visible XLobj 1)  ;; (vla-put-visible XLobj :vlax-true)
    ;;關閉'(vla-put-visible XLobj 0) 或 (vla-put-visible XLobj :vlax-false)
    ;;新增一個空白活頁簿WorkBook物件,並指定給wb-obj
  (setq wb-obj(vlax-invoke-method (vlax-get-property XLobj 'WorkBooks) 'Add))
    ;;建立活頁簿中工作表單物件sheetobj,以便在各儲存格中動作
  (setq sheetobj(MX-get-activesheet wb-obj))
    ;;建立工作表單中儲存格物件
  (setq cells (MX-get-cells sheetobj))
)
;;取得指定的儲存格物件
(defun GET-XL-CELL (wkst row col)
  (vlax-Variant-Value
    (MX-Get-Item (MX-Get-Cells wkst) row col)
  )
)

;;(put-cell-bkcolor 儲存格物件 對齊方式 背景顏色 文字顏色 字高 資料內容)
(defun put-cell-bkcolor(obj atype bkcc txtcc txthh  data)
  (mx-put-horizontalalignment obj atype)
  (mx-put-bold(mx-get-font obj) 0)
  (mx-put-colorindex (mx-get-interior obj) bkcc)
  (mx-put-colorindex (mx-get-font obj) txtcc)
  (mx-put-size(mx-get-font obj) txthh)
  (mx-put-value2 obj data)
)
;;(put-cell-txtcolor 儲存格物件 對齊方式 文字顏色 字高 資料內容)
(defun put-cell-txtcolor(obj atype txtcc txthh data)
  (mx-put-horizontalalignment obj atype)
  (mx-put-bold(mx-get-font obj) 0)
  (mx-put-colorindex (mx-get-font obj) txtcc)
  (mx-put-size(mx-get-font obj) txthh)
  (mx-put-value2 obj data)
)

做到這一步之後感覺腦力有些不夠用了

警告:系統當機中........

真的當機了....能不能講解一下要怎麼做分類呢??
我分不出來哪個資料要填到哪一格!?
也不知道哪些資料要分成同一組.....

剛剛貼上的程式只是單純的把18個圖塊個再同一個sheet 把屬性資料貼上而已!

講白點就是輸出資料罷了.......
如果要整理...請幫助我分析一下要怎麼分類Orz....

附上屬性圖塊，屬性內容，參考看看，有疑問再麻煩提出，小弟再配合，感恩謝謝。

再請教!! 圖層對於分類有幫助嗎???

請問圖層的分類是怎樣的標準呢??圖層名稱後方的編號是有系統的分類嗎?

還是說圖層只關乎"地點"---05南投01草屯06中寮08名間11竹山12鹿谷.....

還有我是應該要一個圖塊的屬性資料就只輸入在一個ROW 還是說有能夠結合的資料呢?<------這好像是蠢問題

喔....少問了一個問題.....

您比較希望是
1.Excel的一個Sheets就是一個地點的所有屬性圖塊資料,而且相同圖塊名稱的屬性資料放在一起

還是說
2.Excell的一個Sheets就是一個圖塊名稱的屬性資料,而且相同地點的資料放在一起

3.都不是....其他!?

PS1:我好像不太知道要怎麼表達我想說的分類問題

PS2:前面那個程式碼能用不能用也請有時間的時候麻煩撤是看看囉!

目前程式進度：
1.已經可以將所有屬性圖塊資料分類依序匯出成excel檔案
2.分類方式為:a.每個excel的sheets為一個圖塊(從Sheets4開始) b.每個圖塊都會依照圖層做排序及分類來列出屬性資料

代碼:

(defun c:PrintATT2Excel()
  (SETVAR "CMDECHO" 0)
  ;;;載入VLA 
  (vl-load-com)
  ;(vl-load-all "PrintATT2Excel")
  (if (null MX-acos) (jinn-get-excel-lib))
  (jinn-creat-excel-sheet)
  (setq acadobj(vlax-get-acad-object))
  (setq dwgobj (vla-get-ActiveDocument acadobj))
  (setq mspace (vla-get-ModelSpace dwgobj))
  ;;;取得 圖塊名稱list("blklist")
  (setq blocksobj (vla-get-blocks dwgobj))
  (setq blklist nil)
  (vlax-for sobj blocksobj
    (setq blkn (vla-get-name sobj))
    (if (/= (substr blkn 1 1) "*")
        (setq blklist (cons (strcase blkn) blklist))
    )
  )
  (setq blklist (acad_strlsort blklist))
  ;;;取得 總圖塊數("nns") 圖塊名稱及選集list("blkss_list") 圖塊名稱及數量list("blknum_list")
  (setq blknum_list nil blkss_list nil)
  (foreach blkn blklist
    (setq ss (ssget "x" (list '(0 . "INSERT") (cons 2 blkn))))
    (if ss
      (progn
   (setq nns (itoa (sslength ss)))
   (setq str1 (list blkn nns))
   (setq blknum_list (cons str1 blknum_list))
   (setq blkss_list (cons (list blkn ss) blkss_list))
   )
      )
    )
  ;;;取得 圖層名稱list("laylist")
  (setq layersobj (vla-get-layers dwgobj))
  (setq laylist nil)
  (vlax-for sobj layersobj
    (setq layn (vla-get-name sobj))
    ;(if (/= layn "DEFPOINTS")
        (setq laylist (cons (strcase layn) laylist))
    ;)
  )
  (setq laylist (acad_strlsort laylist))
  ;;;將屬性圖塊資料寫入excel
  (foreach blkn blklist
    ;;新增一個活頁簿中空白工作表單物件sheetobj,以便在各儲存格中動作
    (setq sheetobj (vlax-invoke-method (vlax-get-property XLobj 'Worksheets) 'Add))
    ;;建立工作表單中儲存格物件
    (setq cells (MX-get-cells sheetobj))
    ;;;建立表頭
    (setq ss (ssget "x" (list '(0 . "INSERT") (cons 2 blkn))))
    (setq i 0 j 0)
    ;;輸入圖塊名稱
    (setq ceobj (get-XL-cell sheetobj (+ i 1) (+ j 1)))
    ;;(put-cell-txtcolor 儲存格物件 對齊方式 文字顏色 字高 資料內容)
    (put-cell-txtcolor ceobj 1 1 12 (strcat "圖塊：" blkn))
    (setq att_obj_list (vlax-safearray->list
          (vlax-variant-value
           (vla-getattributes
             (vlax-ename->vla-object
               (ssname ss i)
               )))))
    (repeat (length att_obj_list)
      (setq att_TagString (vla-get-TagString (nth j att_obj_list)))
      (setq ceobj (get-XL-cell sheetobj (+ i 1) (+ j 2)))
      ;;(put-cell-txtcolor 儲存格物件 對齊方式 文字顏色 字高 資料內容)
      (put-cell-txtcolor ceobj 3 1 12 att_TagString)
      (setq j (1+ j))
      )
    ;;;_結束 建立表頭
    ;;;填寫屬性內容
    (foreach layn laylist
      (setq ss (ssget "x" (list '(0 . "INSERT") (cons 2 blkn) (cons 8 layn))))
      (if (/= ss nil)
   (progn
     (repeat (sslength ss)
       (setq j 0)
       (setq att_obj_list (vlax-safearray->list
             (vlax-variant-value
              (vla-getattributes
                (vlax-ename->vla-object
                  (ssname ss j)
                  )))))
       ;;輸入圖層名稱
       (setq ceobj (get-XL-cell sheetobj (+ i 2) (+ j 1)))
       ;;(put-cell-txtcolor 儲存格物件 對齊方式 文字顏色 字高 資料內容)
       (put-cell-txtcolor ceobj 1 1 12 layn)
       (repeat (length att_obj_list)
         (setq att_TextString (vla-get-TextString (nth j att_obj_list)))
         (setq ceobj (get-XL-cell sheetobj (+ i 2) (+ j 2)))
         ;;(put-cell-txtcolor 儲存格物件 對齊方式 文字顏色 字高 資料內容)
         (put-cell-txtcolor ceobj 3 1 12 att_TextString)
         (setq j (1+ j))
         )
       (setq i (1+ i))
       )
     )
   )
      )
    ;;;_結束 填寫屬性內容
    )
  ;;;_結束 將屬性圖塊資料寫入excel
  (SETVAR "CMDECHO" 1)
  ;;將建立EXCEL 應用程式物件XLobj顯示出來
  ;(vla-put-visible XLobj :vlax-true)
  )
;==============以下資料摘用於"翔虹AutoCAD技術中心"編著的書"AutoCAD程式設計"===============
;;;載入EXCEL應用程式資源庫檔案
(defun jinn-get-excel-Lib ()
  (cond
    ((setq exlib (findfile (strcat "C:\\Program Files (x86)\\Microsoft Office\\" "office\\" "Excel8.olb"))))   
    ((setq exlib (findfile (strcat "C:\\Program Files (x86)\\Microsoft Office\\" "office\\" "Excel9.olb"))))
    ((setq exlib (findfile (strcat "C:\\Program Files (x86)\\Microsoft Office\\" "office\\" "Excel.exe"))))
    ((setq exlib (findfile (strcat "C:\\Program Files (x86)\\Microsoft Office\\" "office10\\" "Excel.exe"))))
    ((setq exlib (findfile (strcat "C:\\Program Files (x86)\\Microsoft Office\\" "office11\\" "Excel.exe"))))
    ((setq exlib (findfile (strcat "C:\\Program Files (x86)\\Microsoft Office\\" "office12\\" "Excel.exe"))))
    ((setq exlib (findfile (strcat "C:\\Program Files\\Microsoft Office\\" "office\\" "Excel8.olb"))))   
    ((setq exlib (findfile (strcat "C:\\Program Files\\Microsoft Office\\" "office\\" "Excel9.olb"))))
    ((setq exlib (findfile (strcat "C:\\Program Files\\Microsoft Office\\" "office\\" "Excel.exe"))))
    ((setq exlib (findfile (strcat "C:\\Program Files\\Microsoft Office\\" "office10\\" "Excel.exe"))))
    ((setq exlib (findfile (strcat "C:\\Program Files\\Microsoft Office\\" "office11\\" "Excel.exe"))))
    ((setq exlib (findfile (strcat "C:\\Program Files\\Microsoft Office\\" "office12\\" "Excel.exe")))) 
    (t (setq exlib nil))
  )
  (if exlib
    (vlax-import-type-library
      :tlb-filename        exlib
      :methods-prefix    "MX-"
      :properties-prefix    "MX-"
      :constants-prefix    "MX-"
      )
    (alert "Excel typelib 檔案不存在")
    )
  )
;;;建立Excel應用程式物件&表單物件
(defun jinn-creat-excel-sheet()
  (setq XLobj (vlax-create-object "Excel.Application"))
  ;;將建立EXCEL 應用程式物件XLobj顯示出來
  (vla-put-visible XLobj 1);; 或 (vla-put-visible XLobj :vlax-true)
  ;;將建立EXCEL 應用程式物件XLobj關閉顯示
  ;(vla-put-visible XLobj 0);; 或 (vla-put-visible XLobj :vlax-false)
  ;;新增一個空白活頁簿WorkBook物件,並指定給wb-obj
  (setq wb-obj(vlax-invoke-method (vlax-get-property XLobj 'WorkBooks) 'Add))
  ;;建立活頁簿中工作表單物件sheetobj,以便在各儲存格中動作
  (setq sheetobj(MX-get-activesheet wb-obj))
  ;;建立工作表單中儲存格物件
  (setq cells (MX-get-cells sheetobj))
  )
;;取得指定的儲存格物件
(defun GET-XL-CELL (wkst row col)
  (vlax-Variant-Value
    (MX-Get-Item (MX-Get-Cells wkst) row col)
    )
  )
;;(put-cell-bkcolor 儲存格物件 對齊方式 背景顏色 文字顏色 字高 資料內容)
(defun put-cell-bkcolor(obj atype bkcc txtcc txthh  data)
  (mx-put-horizontalalignment obj atype)
  (mx-put-bold(mx-get-font obj) 0)
  (mx-put-colorindex (mx-get-interior obj) bkcc)
  (mx-put-colorindex (mx-get-font obj) txtcc)
  (mx-put-size(mx-get-font obj) txthh)
  (mx-put-value2 obj data)
  )
;;(put-cell-txtcolor 儲存格物件 對齊方式 文字顏色 字高 資料內容)
(defun put-cell-txtcolor(obj atype txtcc txthh data)
  (mx-put-horizontalalignment obj atype)
  (mx-put-bold(mx-get-font obj) 0)
  (mx-put-colorindex (mx-get-font obj) txtcc)
  (mx-put-size(mx-get-font obj) txthh)
  (mx-put-value2 obj data)
  )

有時間的話請試用看看!(看看是否有狀況或問題是我的電腦顯示不出來的)
將資料會出到excel的時間稍嫌過長,約五分鐘左右....測試時請千萬勿動用AutoCAD、VisualLisp編輯器及Excel等檔案程式

關於將圖塊屬性輸入到對應的cells內的方法我還在研究.....
如果有結果會在貼上進度

leoneriol 你好
剛剛試了一下，出現訊息，Excel typelib 檔案不存在，這是我的檔案路進不對，還是檔案名稱不對。
按確定後會跳出Excel出來就停了。
請指導，謝謝。

Tanya 寫到:leoneriol 你好
剛剛試了一下，出現訊息，Excel typelib 檔案不存在，這是我的檔案路進不對，還是檔案名稱不對。
按確定後會跳出Excel出來就停了。
請指導，謝謝。

Tanya大客氣了....
能請您有空是提供以下資料嗎?
1.office的版本
2.office的安裝路徑
3.作業系統版本為何
4.作業系統是32bit還是64bit的

PS:我懷疑office的路徑不對,可是您說excel還是有跳出來,所以我有些茫然,再麻煩您提供一下訊息!

leoneriol 安安
1.office的版本:2010_64位元
2.office的安裝路徑:C:\Program Files\Microsoft Office\Office14
3.作業系統版本為何:Win7_64位元
謝謝。

Tanya 寫到:leoneriol 安安
1.office的版本:2010_64位元
2.office的安裝路徑:C:\Program Files\Microsoft Office\Office14
3.作業系統版本為何:Win7_64位元
謝謝。

瞭解了!!那大概就是路徑有問題了!!
以下再請您測試了!

代碼:

(defun c:PrintATT2Excel()
  (SETVAR "CMDECHO" 0)
  ;;;載入VLA 
  (vl-load-com)
  ;(vl-load-all "PrintATT2Excel")
  (if (null MX-acos) (jinn-get-excel-lib))
  (jinn-creat-excel-sheet)
  (setq acadobj(vlax-get-acad-object))
  (setq dwgobj (vla-get-ActiveDocument acadobj))
  (setq mspace (vla-get-ModelSpace dwgobj))
  ;;;取得 圖塊名稱list("blklist")
  (setq blocksobj (vla-get-blocks dwgobj))
  (setq blklist nil)
  (vlax-for sobj blocksobj
    (setq blkn (vla-get-name sobj))
    (if (/= (substr blkn 1 1) "*")
        (setq blklist (cons (strcase blkn) blklist))
    )
  )
  (setq blklist (acad_strlsort blklist))
  ;;;取得 總圖塊數("nns") 圖塊名稱及選集list("blkss_list") 圖塊名稱及數量list("blknum_list")
  (setq blknum_list nil blkss_list nil)
  (foreach blkn blklist
    (setq ss (ssget "x" (list '(0 . "INSERT") (cons 2 blkn))))
    (if ss
      (progn
   (setq nns (itoa (sslength ss)))
   (setq str1 (list blkn nns))
   (setq blknum_list (cons str1 blknum_list))
   (setq blkss_list (cons (list blkn ss) blkss_list))
   )
      )
    )
  ;;;取得 圖層名稱list("laylist")
  (setq layersobj (vla-get-layers dwgobj))
  (setq laylist nil)
  (vlax-for sobj layersobj
    (setq layn (vla-get-name sobj))
    ;(if (/= layn "DEFPOINTS")
        (setq laylist (cons (strcase layn) laylist))
    ;)
  )
  (setq laylist (acad_strlsort laylist))
  ;;;將屬性圖塊資料寫入excel
  (foreach blkn blklist
;;;    (setq k nil)
;;;    (cond
;;;      ((= (strcase blkn) (strcase "HUBV01")) (setq k '(2 3 4)))
;;;      ((= (strcase blkn) (strcase "TN點V02")) (setq k '(2 3 4 9 10 11 17 27)))
;;;      ((= (strcase blkn) (strcase "投落點V01")) (setq k '(2 3 4 5 6 7 8 17 18 19 20 21 22 23 27 28)))
;;;      ((= (strcase blkn) (strcase "預定投落點V01")) (setq k '(2 3 4 5 6 7 8 17 18 19 20 21 22 23 27 28)))
;;;      ((= (strcase blkn) (strcase "投落點EOCv01")) (setq k '(2 3 4 5 6 7 8 17 12 13 14 23 27 28)))
;;;      ((= (strcase blkn) (strcase "預定投落點EOCV01")) (setq k '(2 3 4 5 6 7 8 17 12 13 14 23 27 28)))
;;;      ((= (strcase blkn) (strcase "EPONV01")) (setq k '(2 3 4 12 13 14 17 24 25 26 27 28)))
;;;      ((= (strcase blkn) (strcase "預定EPONV01")) (setq k '(2 3 4 12 13 14 17 24 25 26 27 28)))
;;;      ((= (strcase blkn) (strcase "學術網路V01")) (setq k '(2 3 4 12 13 14 17 24 25 26 27 28)))
;;;      ((= (strcase blkn) (strcase "預定學術網路V01")) (setq k '(2 3 4 12 13 14 17 24 25 26 27 28)))
;;;      ((= (strcase blkn) (strcase "BTS基站V01")) (setq k '(2 3 4 12 13 14 15 16 25 26)))
;;;      ((= (strcase blkn) (strcase "預定BTS基站V01")) (setq k '(2 3 4 12 13 14 15 16 25 26)))
;;;      ((= (strcase blkn) (strcase "MINI NODEV01")) (setq k '(2 3 4 6 7 8 17 24 27 28)))
;;;      ((= (strcase blkn) (strcase "路口監視器V01")) (setq k '(2 3 4)))
;;;      ((= (strcase blkn) (strcase "預定路口監視器V01")) (setq k '(2 3 4)))
;;;      ((= (strcase blkn) (strcase "網咖V01")) (setq k '(2 3 4)))
;;;      ((= (strcase blkn) (strcase "預定網咖V01")) (setq k '(2 3 4)))
;;;      ((= (strcase blkn) (strcase "廣告V01")) (setq k '(2 3 4)))
;;;      ((= (strcase blkn) (strcase "癈除V01")) (setq k '(2 3 4)))
;;;      (t (setq k '(2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60)))
;;;      )
    ;;新增一個活頁簿中空白工作表單物件sheetobj,以便在各儲存格中動作
    (setq sheetobj (vlax-invoke-method (vlax-get-property XLobj 'Worksheets) 'Add))
    ;;建立工作表單中儲存格物件
    (setq cells (MX-get-cells sheetobj))
    ;;;建立表頭
    (setq ss (ssget "x" (list '(0 . "INSERT")  (cons 2 blkn))))
    (setq i 0 j 0)
    ;;輸入圖塊名稱
    (setq ceobj (get-XL-cell sheetobj (+ i 1) (+ j 1)))
    ;;(put-cell-txtcolor 儲存格物件 對齊方式 文字顏色 字高 資料內容)
    (put-cell-txtcolor ceobj 1 1 12 (strcat "圖塊：" blkn))
    (setq att_obj_list (vlax-safearray->list
          (vlax-variant-value
           (vla-getattributes
             (vlax-ename->vla-object
               (ssname ss i)
               )))))
    (repeat (length att_obj_list)
      (setq att_TagString (vla-get-TagString (nth j att_obj_list)))
      (setq ceobj (get-XL-cell sheetobj (+ i 1) (+ j 2)))
;;;      (setq ceobj (get-XL-cell sheetobj (+ i 1) (nth j k)))
      ;;(put-cell-txtcolor 儲存格物件 對齊方式 文字顏色 字高 資料內容)
      (put-cell-txtcolor ceobj 3 1 12 att_TagString)
      (setq j (1+ j))
      )
    ;;;_結束 建立表頭
    ;;;填寫屬性內容
    (foreach layn laylist
      (setq ss (ssget "x" (list '(0 . "INSERT") (cons 2 blkn) (cons 8 layn))))
      (if (/= ss nil)
   (progn
     (repeat (sslength ss)
       (setq j 0)
       (setq att_obj_list (vlax-safearray->list
             (vlax-variant-value
              (vla-getattributes
                (vlax-ename->vla-object
                  (ssname ss j)
                  )))))
       ;;輸入圖層名稱
       (setq ceobj (get-XL-cell sheetobj (+ i 2) (+ j 1)))
       ;;(put-cell-txtcolor 儲存格物件 對齊方式 文字顏色 字高 資料內容)
       (put-cell-txtcolor ceobj 1 1 12 layn)
       (repeat (length att_obj_list)
         (setq att_TextString (vla-get-TextString (nth j att_obj_list)))
         (setq ceobj (get-XL-cell sheetobj (+ i 2) (+ j 2)))
;;;         (setq ceobj (get-XL-cell sheetobj (+ i 2) (nth j k)))
         ;;(put-cell-txtcolor 儲存格物件 對齊方式 文字顏色 字高 資料內容)
         (put-cell-txtcolor ceobj 3 1 12 att_TextString)
         (setq j (1+ j))
         )
       (setq i (1+ i))
       )
     )
   )
      )
    ;;;_結束 填寫屬性內容
    )
  ;;;_結束 將屬性圖塊資料寫入excel
  (SETVAR "CMDECHO" 1)
  ;;將建立EXCEL 應用程式物件XLobj顯示出來
  ;(vla-put-visible XLobj :vlax-true)
  )
;==============以下資料摘用於"翔虹AutoCAD技術中心"編著的書"AutoCAD程式設計"===============
;;;載入EXCEL應用程式資源庫檔案
(defun jinn-get-excel-Lib ()
  (cond
    ((setq exlib (findfile "C:\\Program Files (x86)\\Microsoft Office\\office\\Excel8.olb")))
    ((setq exlib (findfile "C:\\Program Files (x86)\\Microsoft Office\\office\\Excel9.olb")))
    ((setq exlib (findfile "C:\\Program Files (x86)\\Microsoft Office\\office\\Excel.exe")))
    ((setq exlib (findfile "C:\\Program Files (x86)\\Microsoft Office\\office10\\Excel.exe")))
    ((setq exlib (findfile "C:\\Program Files (x86)\\Microsoft Office\\office11\\Excel.exe")))
    ((setq exlib (findfile "C:\\Program Files (x86)\\Microsoft Office\\office12\\Excel.exe")))
    ((setq exlib (findfile "C:\\Program Files (x86)\\Microsoft Office\\office14\\Excel.exe")))
    ((setq exlib (findfile "C:\\Program Files\\Microsoft Office\\office\\Excel8.olb")))
    ((setq exlib (findfile "C:\\Program Files\\Microsoft Office\\office\\Excel9.olb")))
    ((setq exlib (findfile "C:\\Program Files\\Microsoft Office\\office\\Excel.exe")))
    ((setq exlib (findfile "C:\\Program Files\\Microsoft Office\\office10\\Excel.exe")))
    ((setq exlib (findfile "C:\\Program Files\\Microsoft Office\\office11\\Excel.exe")))
    ((setq exlib (findfile "C:\\Program Files\\Microsoft Office\\office12\\Excel.exe")))
    ((setq exlib (findfile "C:\\Program Files\\Microsoft Office\\office14\\Excel.exe")))
    (t (setq exlib nil))
    )
  (if exlib
    (vlax-import-type-library
      :tlb-filename exlib
      :methods-prefix "MX-"
      :properties-prefix "MX-"
      :constants-prefix "MX-"
      )
    (alert "Excel typelib 檔案不存在")
    )
  )
;;;建立Excel應用程式物件&表單物件
(defun jinn-creat-excel-sheet()
  (setq XLobj (vlax-create-object "Excel.Application"))
  ;;將建立EXCEL 應用程式物件XLobj顯示出來
  (vla-put-visible XLobj 1);; 或 (vla-put-visible XLobj :vlax-true)
  ;;將建立EXCEL 應用程式物件XLobj關閉顯示
  ;(vla-put-visible XLobj 0);; 或 (vla-put-visible XLobj :vlax-false)
  ;;新增一個空白活頁簿WorkBook物件,並指定給wb-obj
  (setq wb-obj(vlax-invoke-method (vlax-get-property XLobj 'WorkBooks) 'Add))
  ;;建立活頁簿中工作表單物件sheetobj,以便在各儲存格中動作
  (setq sheetobj(MX-get-activesheet wb-obj))
  ;;建立工作表單中儲存格物件
  (setq cells (MX-get-cells sheetobj))
  )
;;取得指定的儲存格物件
(defun GET-XL-CELL (wkst row col)
  (vlax-Variant-Value
    (MX-Get-Item (MX-Get-Cells wkst) row col)
    )
  )
;;(put-cell-bkcolor 儲存格物件 對齊方式 背景顏色 文字顏色 字高 資料內容)
(defun put-cell-bkcolor(obj atype bkcc txtcc txthh  data)
  (mx-put-horizontalalignment obj atype)
  (mx-put-bold(mx-get-font obj) 0)
  (mx-put-colorindex (mx-get-interior obj) bkcc)
  (mx-put-colorindex (mx-get-font obj) txtcc)
  (mx-put-size(mx-get-font obj) txthh)
  (mx-put-value2 obj data)
  )
;;(put-cell-txtcolor 儲存格物件 對齊方式 文字顏色 字高 資料內容)
(defun put-cell-txtcolor(obj atype txtcc txthh data)
  (mx-put-horizontalalignment obj atype)
  (mx-put-bold(mx-get-font obj) 0)
  (mx-put-colorindex (mx-get-font obj) txtcc)
  (mx-put-size(mx-get-font obj) txthh)
  (mx-put-value2 obj data)
  )

---

Tiger&蘋果爸 寫到: 謝謝熱心程式分享~< 積分 +1>
[公告]關於團隊成員的回文及貢獻

感謝leoneriol大大
測試完再跟你回報，謝謝。

看了這篇討論之後~很想知道大大最後測試的結果如何?
最近有遇到類似的問題~覺得這篇討論最接近我的疑惑~
假設我在圖塊裡建立了4個屬性
EX:1材質2位置3X位置(使用功能變數)4Y位置(使用功能變數)
並在圖面上繪製圖塊完成
之後我資料萃取圖塊的屬性成EXCEL後有4個欄位
過一陣子之後
我修改了圖塊增加第5個屬性5價錢
(或是我一開始就建立5個屬性.但一開始繪製時並未填寫第5項價錢欄位)
資料萃取後EXCEL有價錢欄位(此時為空白)~
而因業務需求在EXCEL內修改填寫價錢了~
到了我這邊~我想直接將資料萃取過後的EXCEL內的價錢欄內的金額~
直接寫回原CAD圖檔內的圖塊~
是否可行?
希望大大能夠回覆我~感謝
---------------------------------------------------
不知道是否跟這個討論串的結果有相關(我個人覺得類似)
或若需要新開文章討論請大大告知我在修改~感謝

太陽的光跡 寫到:看了這篇討論之後~很想知道大大最後測試的結果如何?
最近有遇到類似的問題~覺得這篇討論最接近我的疑惑~
假設我在圖塊裡建立了4個屬性
EX:1材質2位置3X位置(使用功能變數)4Y位置(使用功能變數)
並在圖面上繪製圖塊完成
之後我資料萃取圖塊的屬性成EXCEL後有4個欄位
過一陣子之後
我修改了圖塊增加第5個屬性5價錢
(或是我一開始就建立5個屬性.但一開始繪製時並未填寫第5項價錢欄位)
資料萃取後EXCEL有價錢欄位(此時為空白)~
而因業務需求在EXCEL內修改填寫價錢了~
到了我這邊~我想直接將資料萃取過後的EXCEL內的價錢欄內的金額~
直接寫回原CAD圖檔內的圖塊~
是否可行?
希望大大能夠回覆我~感謝
---------------------------------------------------
不知道是否跟這個討論串的結果有相關(我個人覺得類似)
或若需要新開文章討論請大大告知我在修改~感謝

可能要麻煩您新開文章討論喔,同時也要提醒您 提供能做測試用的資料及圖檔(局部就好)
您的需求是類似沒錯,可是跟此主題做法不相同,此主題主要是將DWG的資料匯出到Excel
您的需求是將Excel的資料輸入至DWG,讀取Excel的資料會是個問題,找出相對應的"圖塊"是另一個問題,將資料寫入圖塊也是個問題,
三個問題都成功解決的話...就可以解決您的問題

謝謝leoneriol大大~的回覆~
待我資料及問題整理過後~我再來開個新文章~
到時再邀請你共襄盛舉囉~

我想,從EXCEL把圖塊讀回DWG然後就定位,基本是只能做一次性的客製化,因為屬性,名稱,圖層,數量....等等或許都可以解決,但插入座標位置極少可能性會每次都一樣,尤其只要有數量差異的可能,位置就一定不一樣,圖塊從DWG轉出成EXCEL時,資料永遠會被放在固定的儲存格,只是值不一樣,但從EXCEL的成果轉入DWG一定會有插入點座標的問題,除非"底圖"永遠不變,只是這可能性很小

個人比較熟OFFICE所以發表一下個人看法,建議,EXCEL其實就是以試算為主業,所以在資料的篩選,比對,運算,分析....等等只是他的基本功,,轉成EXCEL表格之後可以利用EXCEL的公式跟巨集讓他自動整理出你想要的表格,不管是利用這些資料去彙整出報價單,就算是匯入簡報檔,計劃書或企劃書,也可以是日報表,一樣可以達到所要的功能,所以個人的認知是,只要能正確的轉成excel表格,後段的工作就交excel去辦就行囉,因為最主要的工作:database已經取得,後面的工作要cad來做其實有點所託非人,因為各自的專長不同,工具很重要,使用工具的方法更重要,個人的看法是,建議讓程式各自去專業分工就好,我想更可以發揮到極致