[討論]圖塊計算數量後將表格繪製於圖面上並插入圖塊

[問題]選取圖塊計算數量後將表格繪製於圖面上並插入圖塊

q1:此程式會計算圖面所有圖塊,如何改成只有選取範圍內圖塊
q2:含屬性圖塊如不將其過濾排除,就必須分解才可插入於圖表
     有沒有辦法將含屬性圖塊及其值一併繒製插入於表格內[表格須加屬性值欄位]

---------------------------------------------------------------------------------
希望未來cad版本資料萃取有自動將圖塊插入於表格的功能那就太棒了
---------------------------------------------------------------------------------



程式

代碼:

(defun c:bombl()
   (setvar "cmdecho" 0)
   (setq os (getvar "osmode"))
   (setvar "osmode" 0)
   (setq pt1 (getpoint "\n表格左上角插入點: "))
   (setq ww 1200.0);表格總寬度
   (setq hh 100.0);表格高度
   (setq pt2 (polar pt1 0 ww));表格右上角點
   (setq pt3 (polar pt2 (* pi 1.5) hh));表格右下角點
   (setq pt4 (polar pt1 (* pi 1.5) hh))表格左下角點
   (command "pline" pt1 pt2 pt3 pt4 "c");繪表格框線
   (setq pt5 (polar pt1 0 (/ ww 4)));表格第1格右上角點
   (setq pt6 (polar pt5 (* pi 1.5) hh));表格第1格右下角點
   (command "line" pt5 pt6 "");繪表格第1格分隔線
   (setq pt7 (polar pt5 0 (/ ww 2)));表格第2格右上角點
   (setq pt8 (polar pt7 (* pi 1.5) hh));表格第2格右下角點
   (command "line" pt7 pt8 "");繪表格第2格分隔線
   (command "text" "m" (inters pt1 pt6 pt4 pt5) (/ hh 2) 0 "圖塊符號");表格第1格標題
   (command "text" "m" (inters pt5 pt8 pt6 pt7) (/ hh 2) 0 "圖塊名稱");表格第2格標題
   (command "text" "m" (inters pt7 pt3 pt8 pt2) (/ hh 2) 0 "圖塊數量");表格第3格標題
   (setq blk (tblnext "block" t));取出第一個block圖元內含性質
   (while blk
    ;(setq blk1 (assoc 70 blk));取出block屬性
    ;(if(/= (setq blk2 (itoa(cdr blk1))) "2");排除含屬性block
     (progn
       (setq blkn (assoc 2 blk));取出block名稱
       (setq blk_key (substr (cdr blkn) 1 1));取出block名稱
       (if (/= blk_key "*")
         (progn
    (setq ss (ssget "X" (list blkn)));建立過濾block選集
            (if (null ss)
               (setq ssn 0);歸零
               (setq ssn (sslength ss));計算block選集數量            
            )
            (setq blknn (cdr blkn));取出block名稱
    (setq pt1 pt4 pt5 pt6 pt2 pt3 pt7 pt8);點1=點4 點5=點6 依此類推
            (setq pt4 (polar pt1 (* pi 1.5) hh));
            (setq pt6 (polar pt5 (* pi 1.5) hh));
            (setq pt3 (polar pt2 (* pi 1.5) hh));
    (setq pt8 (polar pt7 (* pi 1.5) hh));
    (setq pt9 (polar pt1 (angle pt1 pt6) (/ (distance pt1 pt6) 2.0)));
            (command "pline" pt2 pt3 pt4 pt1 "");
            (command "line" pt5 pt6 "");
    (command "line" pt7 pt8 "");
    (command "text" "m" (inters pt5 pt8 pt6 pt7) (/ hh 2) 0 blknn);寫出block名稱
            (command "text" "m" (inters pt7 pt3 pt8 pt2) (/ hh 2) 0 (itoa ssn));寫出block數量
    (setq blknn (strcat "*" blknn));block名稱加星號分解
    (command "insert" blknn pt9 "1" "1" "0");插入block符號
         )
       )
       ;(setq blk (tblnext "block"));old計算下一個block
     );progn
    ;);if
    (setq blk (tblnext "block"));new計算下一個block
   );while
   (setvar "osmode" os)
   (prompt "bombl")
   (prin1)
)

👇*下載網址回覆可見*

tarpon 寫到:[問題]選取圖塊計算數量後將表格繪製於圖面上並插入圖塊
q1:此程式會計算圖面所有圖塊,如何改成只有選取範圍內圖塊
q2:含屬性圖塊如不將其過濾排除,就必須分解才可插入於圖表
有沒有辦法將含屬性圖塊及其值一併繒製插入於表格內[表格須加屬性值欄位]
---------------------------------------------------------------------------------
希望未來cad版本資料萃取有自動將圖塊插入於表格的功能那就太棒了
---------------------------------------------------------------------------------
程式

代碼:

(defun c:bombl()
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq pt1 (getpoint "\n表格左上角插入點: "))
  (setq ww 1200.0);表格總寬度
  (setq hh 100.0);表格高度
  (setq pt2 (polar pt1 0 ww));表格右上角點
  (setq pt3 (polar pt2 (* pi 1.5) hh));表格右下角點
  (setq pt4 (polar pt1 (* pi 1.5) hh))表格左下角點
  (command "pline" pt1 pt2 pt3 pt4 "c");繪表格框線
  (setq pt5 (polar pt1 0 (/ ww 4)));表格第1格右上角點
  (setq pt6 (polar pt5 (* pi 1.5) hh));表格第1格右下角點
  (command "line" pt5 pt6 "");繪表格第1格分隔線
  (setq pt7 (polar pt5 0 (/ ww 2)));表格第2格右上角點
  (setq pt8 (polar pt7 (* pi 1.5) hh));表格第2格右下角點
  (command "line" pt7 pt8 "");繪表格第2格分隔線
  (command "text" "m" (inters pt1 pt6 pt4 pt5) (/ hh 2) 0 "圖塊符號");表格第1格標題
  (command "text" "m" (inters pt5 pt8 pt6 pt7) (/ hh 2) 0 "圖塊名稱");表格第2格標題
  (command "text" "m" (inters pt7 pt3 pt8 pt2) (/ hh 2) 0 "圖塊數量");表格第3格標題
  (setq blk (tblnext "block" t));取出第一個block圖元內含性質
  (while blk
    ;(setq blk1 (assoc 70 blk));取出block屬性
    ;(if(/= (setq blk2 (itoa(cdr blk1))) "2");排除含屬性block
    (progn
      (setq blkn (assoc 2 blk));取出block名稱
      (setq blk_key (substr (cdr blkn) 1 1));取出block名稱
      (if (/= blk_key "*")
        (progn
       (setq ss (ssget "X" (list blkn)));建立過濾block選集
            (if (null ss)
              (setq ssn 0);歸零
              (setq ssn (sslength ss));計算block選集數量           
            )
            (setq blknn (cdr blkn));取出block名稱
       (setq pt1 pt4 pt5 pt6 pt2 pt3 pt7 pt8);點1=點4 點5=點6 依此類推
            (setq pt4 (polar pt1 (* pi 1.5) hh));
            (setq pt6 (polar pt5 (* pi 1.5) hh));
            (setq pt3 (polar pt2 (* pi 1.5) hh));
       (setq pt8 (polar pt7 (* pi 1.5) hh));
       (setq pt9 (polar pt1 (angle pt1 pt6) (/ (distance pt1 pt6) 2.0)));
            (command "pline" pt2 pt3 pt4 pt1 "");
            (command "line" pt5 pt6 "");
       (command "line" pt7 pt8 "");
       (command "text" "m" (inters pt5 pt8 pt6 pt7) (/ hh 2) 0 blknn);寫出block名稱
            (command "text" "m" (inters pt7 pt3 pt8 pt2) (/ hh 2) 0 (itoa ssn));寫出block數量
       (setq blknn (strcat "*" blknn));block名稱加星號分解
       (command "insert" blknn pt9 "1" "1" "0");插入block符號
        )
      )
      ;(setq blk (tblnext "block"));old計算下一個block
    );progn
    ;);if
    (setq blk (tblnext "block"));new計算下一個block
  );while
  (setvar "osmode" os)
  (prompt "bombl")
  (prin1)
)


這程式 ~ 您自己寫的 ?

我參考吳永進老師autocad程式設計一書中的程式自行加以修改的
lisp都是看書自修有些程序回圈邏輯不是很了解

您的第一個問題.
只要把這一行,
(setq ss (ssget "X" (list blkn)))
換成
(setq ss (ssget '((0 . "insert"))))
就可以由框選來節篩圖塊選集,
不過建議要把這一行放在插入表格那一行之前....
感覺比較合邏輯,
第二個問題,是我的想法....我還沒花時間試出來...所以只能提供想法供參考吧,

在插入屬性圖塊時,緊接著會要求您輸入屬性值,以完成insert動作,
因為先前在處理圖塊時,已經有把圖塊的一些屬性值都抓出來結合成串列了..
有图塊名稱,有屬性值,只要把對應值取出填入,
那插入屬性圖塊應該就可以完成了,
只是屬性值分類處理,要花點時間試程式.
以上是我的想法,不曉得前輩們有沒有更有效率的方法,可以提出來分享.

我有另一個想法將含屬性圖塊先過濾出來
在修改上次boxbom程式結合在一起
不過boxbom程式只單獨對同一圖塊名稱作計算
修改測試回圈好複雜頭好痛

如果能完成在圖面材料計算上會省很多時間

屬性圖塊統計列表,邊查書邊測試, 搞了很久總算皇天不負苦心人,讓我給試出來了 ,我把你的程式拆解成幾個副程式方便解讀,另外再加上一些對屬性資料處理的副程式, 你再測試看看,提供給有需要的人依需求修改

代碼:

(defun c:bombl()
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))
  (setvar "osmode" 0)
  (setq ss (ssget '((0 . "insert"))))            ;建立圖塊選集
  (setq n (sslength ss))
  (setq   i 0
   blk_num_list
    '()
  )
  (repeat n
    (setq blk (ssname ss i))               
    (if   (= (cdr (assoc 0 (entget (entnext blk)))) "ATTRIB")   ;過濾屬性圖塊
      (progn
   (get_attribs blk)
   (setq blk_num_list (cons #bna_as1_as2 blk_num_list))   ;將屬性值結合到串列中
   (setq i (1+ i))
      )
      (setq i (1+ i))
    )                        ;if
  )                        ;repeat
  (cal_ast_blk blk_num_list)               ;統計數量
  (draw_tab)
  )


(defun draw_tab()
  (setq pt1 (getpoint "\n表格左上角插入點: "))
  (setq ww 1200.0)                  ;表格總寬度
  (setq hh 100.0)                  ;表格高度
  (setq pt2 (polar pt1 0 ww))               ;表格右上角點
  (setq pt3 (polar pt2 (* pi 1.5) hh))            ;表格右下角點
  (setq pt4 (polar pt1 (* pi 1.5) hh))            ;表格左下角點
  (command "pline" pt1 pt2 pt3 pt4 "c")            ;繪表格框線
  (setq pt5 (polar pt1 0 (/ ww 4)))            ;表格第1格右上角點
  (setq pt6 (polar pt5 (* pi 1.5) hh))            ;表格第1格右下角點
  (command "line" pt5 pt6 "")               ;繪表格第1格分隔線
  (setq pt7 (polar pt5 0 (/ ww 2)))            ;表格第2格右上角點
  (setq pt8 (polar pt7 (* pi 1.5) hh))            ;表格第2格右下角點
  (command "line" pt7 pt8 "")               ;繪表格第2格分隔線
  (command "text" "m" (inters pt1 pt6 pt4 pt5) (/ hh 2) 0 "圖塊符號");表格第1格標題
  (command "text" "m" (inters pt5 pt8 pt6 pt7) (/ hh 2) 0 "圖塊名稱");表格第2格標題
  (command "text" "m" (inters pt7 pt3 pt8 pt2) (/ hh 2) 0 "圖塊數量");表格第3格標題
  (setq i 0)
  (repeat (length sumlist)
    (setq blk (nth i sumlist))               ;取出第i個block串列
    (setq blkn (car blk))               ;取出block符號
    (setq blk_key1 (cadr blk))               ;取出block_屬性1
    (setq blk_key2 (caddr blk))               ;取出block_屬性2
    (setq blk_k1+k1(strcat blk_key1 " " blk_key2))      ;取出block名稱
    (setq blk_num (cadddr blk))               ;取出block數量
    (setq pt1 pt4 pt5 pt6 pt2 pt3 pt7 pt8)         ;點1=點4 點5=點6 依此類推
    (setq pt4 (polar pt1 (* pi 1.5) hh));
    (setq pt6 (polar pt5 (* pi 1.5) hh));
    (setq pt3 (polar pt2 (* pi 1.5) hh));
    (setq pt8 (polar pt7 (* pi 1.5) hh));
    (setq pt9 (polar pt1 (angle pt1 pt6) (/ (distance pt1 pt6) 2.0)));
    (command "pline" pt2 pt3 pt4 pt1 "");
    (command "line" pt5 pt6 "");
    (command "line" pt7 pt8 "")
    (command "-insert" blkn pt9 "1" "1" "0" blk_key1 blk_key2)      ;插入block符號
    (command "text" "m" (inters pt5 pt8 pt6 pt7) (/ hh 2) 0 blk_k1+k1)   ;寫出block名稱
    (command "text" "m" (inters pt7 pt3 pt8 pt2) (/ hh 2) 0 blk_num)   ;寫出block數量
    (setq i(1+ i))
    );repeat
  (setvar "osmode" os)
  (prompt "bombl")
  (prin1)
  )

(defun get_attribs(#blk)                  ;取得圖塊的屬性
  (setq #bkname (cdr (assoc 2 (entget #blk))))            
  (setq #bk_1 (entnext #blk))                  
  (setq #bk_2 (entnext #bk_1))                  
  (setq #bk_as1 (cdr (assoc 1 (entget #bk_1))))            
  (setq #bk_as2 (cdr (assoc 1 (entget #bk_2))))            
  (setq #bna_as1_as2 (list #bkname #bk_as1 #bk_as2))         
  )

(defun cal_ast_blk(#tmplist)         ;計算圖塊的加總
  (setq   sumlist '() nextlist '() onnum 0 num 0)
  (setq txttbase (nth 0 #tmplist))      
  (while txttbase            
    (repeat (length #tmplist)
      (setq txtt (nth onnum #tmplist))
      (if (= (strcat (car txttbase) " " (cadr txttbase)" " (caddr txttbase))
       (strcat (car txtt) " " (cadr txtt) " " (caddr txtt)))
   (setq num (1+ num))         
   (setq nextlist (cons txtt nextlist))   
   );if
      (setq onnum (+ 1 onnum))
      );repeat
    (setq sumlist (cons (list (car txttbase) (cadr txttbase) (caddr txttbase) (itoa num)) sumlist))
    (setq #tmplist nextlist nextlist '())   
    (setq onnum 0 num 0)
    (if   (= #tmplist nil)         
      (setq txttbase nil)
      (setq txttbase (nth 0 #tmplist))
    );if
  );while
  )

---

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

不好意思,程式處理的不夠完善,仍有部份需做修改:

請把底下過濾圖塊判斷式的這一行更正,才不會在一併選取非屬性圖塊時,程式產生錯誤,

以下回復可見...

最近在忙一個新案子一直沒上來看
謝謝ginse0727提供的程式
我這兩天找時間測試一下再上來報告
感恩呢

最近工作剛好有需要用到
謝謝ginse0727提供的程式

一定要來看一下這個修改後的程式 買了書 確一直沒有好好的研究

感謝大大的無私分享!!!!!~~~

工作常常用的到~~但我還是有點看不懂也~~~

這一定要來試試看，普渡眾生呀！

同一圖塊內含一個以上屬性仍無法解決再繼續用功

-------------------------------------------------
屬性萃取2006較簡單2007以後選項一堆很多都用不到
彼而變複雜了軟體應該越來越簡便
可是autocad一些簡單指令好像越來越複雜了ex 3d旋轉,屬性萃取

屬性圖塊資料的輸出..是很多人會遇到的問題..
各公司的輸出表格型式也大不相同.一直以來感覺上都須要客製化的程式來處理
有沒有人可以提供一下含有屬性的圖檔..
以及.輸出表格的型式...有空我來當家庭作業..練習一下..

shenhung 寫到:屬性圖塊資料的輸出..是很多人會遇到的問題..
各公司的輸出表格型式也大不相同.一直以來感覺上都須要客製化的程式來處理
有沒有人可以提供一下含有屬性的圖檔..
以及.輸出表格的型式...有空我來當家庭作業..練習一下..

需求
圈選所要計算圖塊選集計算數量
表格繪製於cad圖面
參考圖檔請到免費空間下載如下連結

第一載點
內含一個以上屬性圖塊
http://www.badongo.com/file/25190704
內含一個屬性圖塊
http://www.badongo.com/file/25190728
無屬性圖塊
http://www.badongo.com/file/25190733

第二載點


第一欄>>圖塊[插入圖塊]
第二欄>>圖塊名稱
第三欄>>屬性值[若含有一個以上屬性自動增加欄位,若無屬性即無此欄位]
第四欄>>圖塊數量[沒屬性及不同屬性分別計算]

如果完成真是萬分感激您

tarpon
你的圖檔.是原始檔案..
你能不能.將這些有屬性的..插入一張圖裡..直接輸入屬性資料..
我想知道你的資料長度.和內容..
第三欄.屬性值[若含有一個以上屬性自動增加欄位,若無屬性即無此欄 位]
這點不太懂..能不能請你直接畫你要表格給我..!!有欄位.和無欄位的..
這樣子..會比較了解.

shenhung 寫到:tarpon
你的圖檔.是原始檔案..
你能不能.將這些有屬性的..插入一張圖裡..直接輸入屬性資料..
我想知道你的資料長度.和內容..
第三欄.屬性值[若含有一個以上屬性自動增加欄位,若無屬性即無此欄 位]
這點不太懂..能不能請你直接畫你要表格給我..!!有欄位.和無欄位的..
這樣子..會比較了解.

已mail給您麻煩您了
怕您沒收到下載點
第一載點
http://www.badongo.com/file/25193519

第二載點

抓點模式.和圖層鎖住排除..程式已修正..
程式更新檔載點(*回覆可見*)

代碼:


;----計算圖塊並列表--------------
;--------------------------------
;指令  dbom
;
;僅以屬性數量做基本排序----------
;--------------------------------
;屬性值排序未指定位置,無法排序---
;--------------------------------
;更新抓點模式.和圖層鎖住圖塊排除-
;--------------------------------
(defun dbom_err(st)
(if osmode (setvar "osmode" osmode))
(setq *error* old_err)
(setvar "cmdecho" 1)
(princ)  
)
;-----------------------------------------------------------------------
(defun c:dbom(/)
  (setvar "cmdecho" 0)
  (setq osmode (getvar "osmode"))
  (getbom_block)
  (draw_bom)
  (setq *error* old_err)
  (setvar "osmode" osmode)
  (setvar "cmdecho" 1)
  (princ)
  
)
;--------------------------------------------------------------------------
;----選擇圖塊.並過濾圖塊..-------------------------------------------------
(defun getbom_block( / bom_str bom_str1 bom_en bb_name  m-ent en2 att_nae att_val w i bb_layer layer_list)
    (setq old_err *error* *error* dbom_err)
    (setq bom_ss(ssget '((0 . "INSERT"))))
    (setq i 0  @att_lng 0)
    (setq bom_f1 '())   ;無屬性數量串列
    (setq bom_att '())  ;有屬性串列
    (setq bom_str "")   ;屬性字串
    (setq bom_str1 '()) ; 屬性串列
    (repeat (sslength bom_ss)
            (setq bom_en (ssname bom_ss i))
            (setq bb_name  (dxfa 2  bom_en))
            (setq bb_layer (dxfa 8  bom_en))  ;圖層
            (setq layer_list (tblsearch "layer" bb_layer))
        (if (= (cdr (assoc 70 layer_list)) 0)  ;過濾掉圖層鎖住的物件  (70 .4) 為鎖住.
            (progn    
            (setq m-ent (dxfa -1 bom_en))
            (setq en2 (entnext m-ent))
    (if (/= en2 nil)
 (progn
 (if (= (dxfa 0 en2) "ATTRIB") ;有屬性圖塊
     (progn
     (setq w 0)  
     (while(/= (dxfa 0 en2) "SEQEND")
                   (setq att_name (dxfa 2 en2))  ;屬性名
           (setq att_val  (dxfa 1 en2))  ;屬性值
           (if  (= w 0)
        (progn
        (setq bom_str  (strcat bb_name "|" att_name "," att_val))
 (setq bom_str1 (cons bb_name bom_str1))
 (setq bom_str1 (cons (strcat att_name att_val) bom_str1))
 )
        (progn
                (setq bom_str  (strcat bom_str  "|" att_name "," att_val))
        (setq bom_str1 (cons (strcat att_name att_val) bom_str1))
 )
      
   )  
                   (setq en2 (entnext en2))
           (setq w (1+ w))
     );WHILE
     (setq bom_att (cons (list (reverse bom_str1) bom_str) bom_att)) ;將圖塊屬性.放到bom_att串列內
     (setq bom_str ""  bom_str1 '())   ; 設初始變數
     (if (> w @att_lng) (setq @att_lng w))  ;設置屬性數量
     );progn
     (bom-none)
 );  if
 ) ;PROGN  處理有屬性圖塊結束~
           (bom-none)    
    )  
       ));if progn  圖層打開.才處理過濾
    
           (setq i (1+ i))
    );repeat
    

)  
;---------------------------------------------------------------------------------
(defun draw_bom()
    (setq th   50)       ;字高
    (setq bom_ht   100)  ;欄框高度
    (setq bom_wid1 400)  ;圖例寬度
    (setq bom_wid2 1000) ;圖塊名稱寬度
    (setq bom_wid3 400)  ;數量度
    (setq bom_wid4 400)  ;屬性度
    (setq long_list '(400 1000 400)) ;wid1 wid2 wid3
    (setq bom_text '("圖  例" "圖塊名稱" "數量"))
    (setq att_text '("屬性標籤+值-" "屬性標籤+值二" "屬性標籤+值三" "屬性標籤+值四"  "屬性標籤+值五"))
    (setq base_long (+ bom_wid1 bom_wid2 bom_wid3))
    
;--------------------------------------------------------------------------------
    (setq spt (getpoint "\n插入點:"))
    (cond ((= @att_lng nil)  ;無屬性塊
   (setq all_long base_long)
  )
  ((/= @att_lng nil)  ;有屬性塊加入屬性寬度x屬性數量
   (setq all_long (+ base_long (* @att_lng bom_wid4)))
  )
    )
;---------畫檔頭-------------------------------------------------------------------
   (setvar "osmode" 0)
   (draw_bom_val nil nil)
  
;----------------------------------------------------------------------------------
            (if (/= bom_f1 nil)                       ;無屬性圖塊..畫出.
        (progn
 (setq mm 0)
 (repeat (length bom_f1)
     (setq f1_en (nth mm bom_f1))
     (setq block_name (car f1_en))
     (setq block_quan (cdr f1_en))
     (setq bom_text (list "" block_name block_quan))
     (setq att_text '(""))
     (draw_bom_val block_name 0)
     (setq mm (1+ mm))
 );repeat
 )
    ); if
            (if (/= bom_att nil)                       ;有屬性圖快畫出
        (progn
 (setq bom_att (sort_bom1 bom_att))  ; 屬性長度排序
 (setq bom_qu (reverse (sort_bomx bom_att))) ;計算有屬性圖塊塊量
 
 (setq mm 0)
 (repeat (length bom_qu)
        (setq f1_temp (nth mm bom_qu))
        (setq en_qu  (cdr f1_temp))
        (setq val_list (cutstr_plus (nth 0 (car f1_temp)) '("|")))
        (setq block_name (nth 0 val_list))
        (setq att_val  (nth 1 val_list))
        (setq bom_text (list "" block_name en_qu))
        (setq oo 1 att_text '())
        (repeat (1- (length val_list))
        (setq att_text (cons (nth oo val_list) att_text))
        (setq oo (1+ oo))
 )  
        (setq att_text (reverse att_text) att_qu 1)
        (draw_bom_val block_name 1)
        (setq mm (1+ mm))
 )
 );progn
           )
)  
;---------------------------------------------------------------------------------
;------畫欄框---------------------------------------------------------------------
(defun draw_bom_val(bk_name key /  ii jj pt1 pt2 pt3 pt4 Q txt1 txt2 lpt1 lpt2)
    ; key  識別..有屬性為1 .無屬性為o..標題欄字 nil
    ;bk_name  -->block name
    (setq ii 0 jj 0)
    (setq an (* pi (/ 270.0 180.0)))
    (setq pt1 spt)
    (setq pt2 (polar pt1 0 all_long))
    (setq pt3 (polar pt1 an bom_ht))
    (setq pt4 (polar pt2 an bom_ht))
    (command "pline" pt1 pt2 pt4 pt3 pt1 "")
    (if (/= @att_lng nil)
        (setq Q (+ 3 @att_lng))
        (setq Q 3)
    )  
    
    (setq tx1 pt1)
    (setq lpt1 pt1 lpt2 pt3)
    (repeat Q
             (cond ((< ii 2)
    (setq lpt1 (polar lpt1 0 (nth ii long_list)))
                    (setq lpt2 (polar lpt2 0 (nth ii long_list)))
    (setq tx2 lpt2)
    (cond ((and (= key 0)(= ii 0)) ;無屬性block 迴圈第1次..插入圖塊
   (command "insert" bk_name (midpt tx1 tx2) "" "" "")
                          )
  ((and (= key 1)(= ii 0)) ;有屬性block,迴圈第1次..插入圖塊
           (setq k 0)
           (setvar "attdia" 0)  ;交談框輸入關閉
           (command "_insert" bk_name (midpt tx1 tx2) "1" "1" "0")
                  (repeat (length att_text)   ;輸入屬性值..
                    (command   (nth 1 (cutstr_plus (nth k att_text) '(",")))
              
    )  ;
                      (setq k (1+ k))
                  )
                        
  ) ;
            )    
    (setvar "attdia" 1)    
    (command "line" lpt1 lpt2 "")
    (command "text" "m" (midpt tx1 tx2) th  0 (nth ii bom_text))
  
                  )
                 ((and (< 1 ii (+ 2 @att_lng)) (/= @att_lng 0))
 
  (setq lpt1 (polar lpt1 0 bom_wid4))
                  (setq lpt2 (polar lpt2 0 bom_wid4))
  (setq tx2 lpt2)
          (command "line" lpt1 lpt2 "")
  (if (and (= key 1) (< jj (length att_text)))
      (command "text" "m" (midpt tx1 tx2) th  0 (vl-string-subst "" "," (nth jj att_text)))
      (command "text" "m" (midpt tx1 tx2) th  0 (nth jj att_text))
    
  )  
          (setq jj (1+ jj))
 )
         (T
 
  (setq lpt1 (polar lpt1 0 (nth 2 long_list)))
  (setq lpt2 (polar lpt2 0 (nth 2 long_list)))
  (setq tx2 lpt2)
  (command "text" "m" (midpt tx1 tx2) th  0 (nth 2 bom_text))  ; 最後一個..直接寫入數量抬頭..
                 )
 
 
   )
   (setq tx1 lpt1)  
           (setq ii (1+ ii))  
    );repeat
     (setq spt pt3)
)  
;-------無屬性圖塊.直接計算數量-----------------------------------------------------
(defun bom-none( / bktrue bom_quan new_bk_list)
            (setq bk_true (assoc bb_name bom_f1)) ;檢查圖塊是否在數量串列內..
    (if (= bk_true nil)
        (setq bom_f1 (cons (cons bb_name 1) bom_f1))   ;如果不存在..加入圖塊..數量設為1
        (progn
        (setq bom_quan (cdr bk_true))                  
        (setq new_bk_list (cons bb_name (1+ bom_quan)))   ;如果存在.取出串列內 資料..數量加1
        (setq bom_f1 (subst new_bk_list bk_true bom_f1))  ;替換 串列
        )
    )
 
)
;---------------------------------------------------------------------------------
;-------有屬性圖塊.以屬性數量做為排序----------------------------------------------
(defun sort_bom1 (x_list / a b)
     (vl-sort x_list '(lambda (a b)
 (< (length (car a))  (length (car b)))))
)

;------計算屬性數量-------------------------------------------------------------------
(defun sort_bomx (x_list / temp i ss val val_true bom_quan new_bk_list)
            (setq temp '() i 0)
            (repeat (length x_list)
            (setq ss (nth i x_list))
            (setq val (cdr ss))
            (setq val_true (assoc val temp))  ;檢查 屬性資料串是否在串列內
            (if (= val_true nil)
                (setq temp (cons (cons val 1) temp))  ;如果不存在..加入屬性資料串.數量設為1
                (progn
                (setq bom_quan (cdr val_true))
                (setq new_bk_list (cons val (1+ bom_quan)))   ;如果存在.取出串列內 資料..數量加1
                (setq temp (subst new_bk_list val_true temp)) ;替換 串列
 )
            )
     (setq i (1+ i))
    )
(if temp temp)

)
;-以下為副程式---------------------------------------------------------------------
;----------------------------------------------------------------------------------
;-取得dxf 碼-----------------------------------------------------------------------
(defun dxfa (code entity / dxf_lis)
  (setq dxf_lis (cdr (assoc code (entget entity (list "*")))))
)
;----2點取中點--------------------------------------------------------------------
(defun midpt (first_pt end_pt)
     (setq mpt (polar first_pt (angle first_pt end_pt) (/ (distance first_pt end_pt) 2)))
     (if mpt mpt)
)
;---------------------------------------------------------------------------------
;------------中文字串轉成串列----------------------------------------------------
(defun cutstr_plus(txt# lis / bs ii ww b al key_code str_int str_length)
      (setq al '())
      (setq bs "")
      (setq ii 0 ww 1)
      (setq key_code (ascii (nth 0 lis)))
      (setq str_code (vl-string-elt txt# ii)) ;找出ascii 碼
      (setq str_length (strlen txt#))
      (while (/= ii  str_length)
      
      (if    (and (or (<=  65 str_code 90)   ; A-Z         英文字
      (<=  97 str_code 122) ; a-z
      (<=  48 str_code 57) ; 0-9
      (=  str_code  32) ;空白
      (=  str_code  34) ;  " 引號
      (=  str_code  40) ;(                  
      (=  str_code  41) ;)
      (=  str_code  46) ; _
      (=  str_code  45) ; -
      (=  str_code 61)   ;=
  )
  (/=  str_code key_code)
             )
     (progn
          (setq bs (strcat bs (substr txt# ww 1) ))
          (setq ww (1+ ww) ii (1+ ii))
     )
             (if (= str_code key_code)
         (progn
     (if (/= ii 0)
     (setq al (cons bs al));如果遇到斷字元..就把字串加入
                     )
     (setq bs "")
     (setq ww (1+ ww) ii (1+ ii))
 )
         (progn
 (setq bs (strcat bs (substr txt# ww 2))) ;中文字
 (setq ww (+ ww 2) ii (+ ii 2))
 )  
    )
     ) ;if
        (if (/= ii   str_length)
 (setq str_code (vl-string-elt txt# ii)) ;找出ascii碼
 )  
      );while
      (setq al (reverse (cons bs al)))
      
     (if al al)
) ;defun
;---------------------------------------------------------------------------------
(princ)

---

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

shenhung
太感謝您了
我的lisp太肉腳了
[需要好好學習一下]
您這程式造福太多人了
除了感謝還是感謝

-----------------------
如果有設物件鎖定會發生錯誤
開頭取消物件鎖定加
(setvar "osmode" 0)
結尾回復物件鎖定
(setvar "osmode" 55)
-----------------------
另外要如何排除鎖住圖層圖塊?

shenhung 寫到:抓點模式.和圖層鎖住排除..程式已修正..
程式更新檔載點..(0314)
http://db.tt/5910EfY

真的是太專業了~
論壇的其他朋友有用到要記得感恩!

shenhung 提供的程式能夠快速統計圖塊數量,
值得讚賞.

惟若系統變數「ATTREQ」值為0時,
此程式會產生一點小小的問題.

另外, 表格如果能夠考慮到不同尺寸的圖塊,
就更完美了

我不會寫 lisp 程式,但 lisp 程式有輔助 cad 在各別領域製圖上的幫助.各位高手們所提供的見解、說明及 lisp 程式,對於我在工作上有所幫助,非常感謝各位大大們無私的分享.

副程式的分類很清楚,註解的也很詳細,
感謝前輩無私的方享程式碼,
觀摩這麼有條理的程式,讓我這種半桶水的後輩獲益良多,
謝謝.

謝大大的無私分享!!!!!~~~