[原创]CAD中收集图纸中存在的BOM信息

zctao1966 · 发表于 2010-11-18 19:59:00

;;;--------------------------------------------------------
;;;函数：xx
;;;--------------------------------------------------------
;;;编制日期:2010.11.18
;;;编制者:曾敏辉
;;;说明:本函数用以收集图纸中的BOM信息
;;;事先在图纸中设置TEXT文字信息,并保存在相应的图层,
;;;如文件较多,可做一模板文件，再修改相关文字即可
;;;图层:材质,客户,数量,图号,图名,版本,版本描述
;;;加载方法：
;;;打开AutoCAD,输入命令:ap,找到此lisp文件,点加载,关闭对话框,输入xx即可执行此命令。
;;;或者直接将此lisp文件拉入CAD视窗即可
;;;自动加载方法：
;;;打开AutoCAD,输入命令:ap,点“内容...”,找到此lisp文件,点“添加”,关闭对话框,重启CAD。
;;;以后只要输入xx就可以执行此命令。
;;;如有问题或更好的想法请到<http://623276955.qzone.qq.com>里留言
;;;声明:本程序旨在抛砖引玉,用于提供例子,增加实际应用功能,减轻设计者的重复用脑。
;;; 欢迎修改,适合自己才是真正的好程序。
;;;■【运行平台】:
;;;Windows 2000、Windows XP
;;;Autocad2004、Autocad2006、Autocad2007、Autocad2008、Autocad2010
;;;--------------------------------------------------------
(defun c:xx( / b1 b2 b3 bb1 bb2 bb3 bbh bm1 bm2 bm3 bs2 bt1 bt2 bt3 count date0 date1 date2 date3 dim_h dim_h1 dim_h2 dim_hl dqzg dwg dwg1 en en2 en3 en4 enn ent ent2 ent3 ent4 f1 f2 filename kw minmoth n2 nou old_plinewid oldsty osmode_old p1 p2 path pt0 pt0_x pt0_y pt1 pt10 pt11 pt12 pt13 pt14 pt2 pt3 pt4 pt5 pt6 pt7 pt701 pt8 pt801 pt9 s1 s2 s3 s4 sbb scz skh sms ss ss1 ss2 ss3 ss4 ssl sth stm str wez wez2 wez3 wez4 wo zbs1 zhy)
(SETVAR "CMDECHO" 0)
(command "undo" "be")
(setq osmode_old (getvar "OSMODE")) ;;捕捉设置
(setq old_PLINEWID (getvar "PLINEWID"));;;取得pline线宽
(setq oldsty (getvar "TEXTSTYLE"));取当前文字样式
(setvar "plinewid" 0);;;设置当前pline线宽为0
;;绘制表头
(setq enn (entlast))
(setq pt0 (getpoint "\n请指定表格绘制位置:"))
(setvar "OSMODE" 0)
(setq pt0_x (car pt0)
pt0_y (cadr pt0)
)
(SETQ PT1 (polar PT0 0 8)
PT3 (polar PT1 0 8)
PT5 (polar PT3 0 18)
PT7 (polar PT5 0 40)
PT701 (polar PT7 0 10)
PT2 (polar PT1 (* -0.5 PI) 4)
PT4 (polar PT3 (* -0.5 PI) 4)
PT6 (polar PT5 (* -0.5 PI) 4)
PT8 (polar PT7 (* -0.5 PI) 4)
PT801 (polar PT701 (* -0.5 PI) 4)
PT9 (polar PT0 (* -0.5 PI) 4)
)
(COMMAND "color" 7);;;内框颜色
(COMMAND "LINE" PT1 PT701 "")
(COMMAND "LINE" PT2 pt801 "")
(SETQ ZBS1 (entlast))
(SETQ PT10 (polar PT0 (* -0.5 PI) (/ 4 2.0))
PT10 (polar PT10 0 (/ 8 2.0))
)
(SETQ PT11 (polar PT10 0 (/ (+ 8 8) 2.0))
PT12 (polar PT11 0 (/ (+ 8 18) 2.0))
PT13 (polar PT12 0 10)
PT14 (polar PT13 0 44)
)
(if (not (tblsearch "style" "simplex"))
(command "_.style" "simplex" "simplex" "0" "0.8" "0" "N" "N" "N")
)
(if (not (tblsearch "style" "宋体"))
(command "_.style" "宋体" "宋体" "" "" "" "" "")
)
(setvar "TEXTSTYLE" "宋体")
(COMMAND "color" 7);;;文字颜色
(COMMAND "TEXT" "J" "MC" PT11 2.4 0.0 "序号")
(COMMAND "TEXT" "J" "MC" PT12 2.4 0.0 "图号")
(COMMAND "TEXT" "J" "MC" (polar PT12 0 25) 2.4 0.0 "名称")
(COMMAND "TEXT" "J" "MC" PT14 2.4 0.0 "数量")
;;表头绘制完毕
(princ "\n本函数用以收集图纸中的BOM信息,请选择一个范围:")
(setq date0 (menucmd "M=$(edtime,$(getvar,date),MO)"))
(if(= (atof date0) 1) (setq minmoth (strcat "JAN"))
(if(= (atof date0) 2) (setq minmoth (strcat "FEB"))
(if(= (atof date0) 3) (setq minmoth (strcat "MAR"))
(if(= (atof date0) 4) (setq minmoth (strcat "APR"))
(if(= (atof date0) 5) (setq minmoth (strcat "MAY"))
(if(= (atof date0) 6) (setq minmoth (strcat "JUN"))
(if(= (atof date0) 7) (setq minmoth (strcat "JUL"))
(if(= (atof date0) 8) (setq minmoth (strcat "AUG"))
(if(= (atof date0) 9) (setq minmoth (strcat "SEP"))
(if(= (atof date0) 10) (setq minmoth (strcat "OCT"))
(if(= (atof date0) 11) (setq minmoth (strcat "NOV"))
(if(= (atof date0) 12) (setq minmoth (strcat "DEC"))
))))))))))));;;结束判别
(setq date1 (menucmd "M=$(edtime,$(getvar,date),DD)"))
(setq date2 (menucmd "M=$(edtime,$(getvar,date),YYYY)"))
(setq date3 (strcat minmoth "-" date1 "-" date2))
(setq dwg (getvar "DWGNAME") ;取当前文档名
path (getvar "dwgprefix") ;取当前文档路径
)
(setq filename (strcat path dwg ".XLS"))
(setq f1 (open filename "w"));;;并且写模式打开一文本文件，
(setq f2 (strcat "序号" "\t" "图纸编号" "\t" "数量" "\t" "图纸名称" "\t" "材质" "\t" "版本" "\t" "版本描述" "\t" "客户" ))
(setq dwg1 (strcat date3 "\t" "\t" dwg "--BOM表"))
(write-line dwg1 f1);;;写文档标题在第一行
(write-line f2 f1)
(setq p1 (getpoint "\n第一角点 :"))
(setq p2 (getcorner p1 "\n第二角点 :"))
(princ "\n正在收集数据,请稍候......")
(if (and
(setq ss1 (ssget "W" p1 p2 '((0 . "text") (8 . "图号"))));;;过滤选择集层名为"图号"的单行文本
(setq ss2 (ssget "W" p1 p2 '((0 . "text") (8 . "数量"))));;;过滤选择集层名为"数量"的单行文本
(setq ss3 (ssget "W" p1 p2 '((0 . "text") (8 . "图名"))));;;过滤选择集层名为"图名"的单行文本
(setq ss4 (ssget "W" p1 p2 '((0 . "text") (8 . "材质"))));;;过滤选择集层名为"材质"的单行文本
(setq bb1 (ssget "W" p1 p2 '((0 . "text") (8 . "版本"))));;;过滤选择集层名为"版本"的单行文本
(setq bb2 (ssget "W" p1 p2 '((0 . "text") (8 . "版本描述"))));;;过滤选择集层名为"版本描述"的单行文本
(setq bb3 (ssget "W" p1 p2 '((0 . "text") (8 . "客户"))));;;过滤选择集层名为"客户"的单行文本
);;;end and
(progn
(setq count 0);;;先设定基数为0
(setq s1 (SORT-SE ss1 10 1 0.001 T));;;按照10组码的Y坐标排序(1),从上往下(T)
(setq s2 (SORT-SE ss2 10 1 0.001 T));;;按照10组码的Y坐标排序(1),从上往下(T)
(setq s3 (SORT-SE ss3 10 1 0.001 T));;;按照10组码的Y坐标排序(1),从上往下(T)
(setq s4 (SORT-SE ss4 10 1 0.001 T));;;按照10组码的Y坐标排序(1),从上往下(T)
(setq b1 (SORT-SE bb1 10 1 0.001 T));;;按照10组码的Y坐标排序(1),从上往下(T)
(setq b2 (SORT-SE bb2 10 1 0.001 T));;;按照10组码的Y坐标排序(1),从上往下(T)
(setq b3 (SORT-SE bb3 10 1 0.001 T));;;按照10组码的Y坐标排序(1),从上往下(T)
(setq
sth (sslength s1)
ssl (sslength s2)
stm (sslength s3)
scz (sslength s4)
sbb (sslength b1)
sms (sslength b2)
skh (sslength b3)
)
(princ "\n共选择文本型文字:")
(princ "\n 图号<")
(princ sth )
(princ ">个,")
(princ "\n 数量<")
(princ ssl )
(princ ">个,")
(princ "\n 图名<")
(princ stm )
(princ ">个,")
(princ "\n 材质<")
(princ scz )
(princ ">个,")
(princ "\n 版本<")
(princ sbb )
(princ ">个,")
(princ "\n 描述<")
(princ sms )
(princ ">个,")
(princ "\n 客户<")
(princ skh )
(princ ">个。")
(if (or (/= sth ssl ) (/= ssl stm ) (/= stm scz ) (/= scz sbb ) (/= sbb sms ) (/= sms skh ) (/= skh sth ))
(alert "你所选择的<图号,数量,图名,材质,版本,版本描述,客户>个数不一致,请仔细检查自动生成的BOM表!或在CAD状态下按F2查看")
)
(repeat sth;;;依次读取选择集中每一个对象
(setq en (ssname s1 count);;;取得选取对象的名字
ent (entget en);;;获得对象的组码表，以便下一步提取
);;;end setq
(setq wez(cdr (assoc 1 ent));;;对象组码表为1，对应的是单行文字的值
);;;end setq
ssl;;;依次读取选择集中每一个对象
(setq en2 (ssname s2 count);;;取得选取对象的名字
ent2 (entget en2);;;获得对象的组码表，以便下一步提取
);;;end setq
(setq wez2(cdr (assoc 1 ent2));;;对象组码表为1，对应的是单行文字的值
);;;end setq
stm;;;依次读取选择集中每一个对象
(setq en3 (ssname s3 count);;;取得选取对象的名字
ent3 (entget en3);;;获得对象的组码表，以便下一步提取
);;;end setq
(setq wez3(cdr (assoc 1 ent3));;;对象组码表为1，对应的是单行文字的值
);;;end setq
scz;;;依次读取选择集中每一个对象
(setq en4 (ssname s4 count);;;取得选取对象的名字
ent4 (entget en4);;;获得对象的组码表，以便下一步提取
);;;end setq
(setq wez4(cdr (assoc 1 ent4));;;对象组码表为1，对应的是单行文字的值
);;;end setq
sbb;;;依次读取选择集中每一个对象
(setq bt1(ssname b1 count);;;取得选取对象的名字
bm1 (entget bt1);;;获得对象的组码表，以便下一步提取
);;;end setq
(setq bbh (cdr (assoc 1 bm1));;;对象组码表为1，对应的是单行文字的值
);;;end setq
sms;;;依次读取选择集中每一个对象
(setq bt2(ssname b2 count);;;取得选取对象的名字
bm2 (entget bt2);;;获得对象的组码表，以便下一步提取
);;;end setq
(setq bs2 (cdr (assoc 1 bm2));;;对象组码表为1，对应的是单行文字的值
);;;end setq
skh;;;依次读取选择集中每一个对象
(setq bt3(ssname b3 count);;;取得选取对象的名字
bm3 (entget bt3);;;获得对象的组码表，以便下一步提取
);;;end setq
(setq bt3 (cdr (assoc 1 bm3));;;对象组码表为1，对应的是单行文字的值
);;;end setq
(if (< count 10)
(setq n2 (strcat "0" (itoa count)));;;编号一个个更改
)
(if (and (>= count 10) (< count 100))
(setq n2 (strcat (itoa count)));;;编号一个个更改
)
(if (>= count 100)
(setq n2 (strcat (itoa count)));;;编号一个个更改
)
(setvar "OSMODE" 0)
(COMMAND "COPY" ZBS1 "" pt0 pt9)
(SETQ ZBS1 (entlast)
pt11 (polar PT11 (* -0.5 PI) 4)
pt12 (polar PT12 (* -0.5 PI) 4)
pt13 (polar PT13 (* -0.5 PI) 4)
pt14 (polar PT14 (* -0.5 PI) 4)
)
(setvar "TEXTSTYLE" "simplex")
(COMMAND "TEXT" "J" "MC" PT11 2.4 0.0 n2);;;序号
(COMMAND "TEXT" "J" "MC" PT12 2.4 0.0 wez);;;图号
(setvar "TEXTSTYLE" "宋体")
(COMMAND "TEXT" "J" "ML" PT13 2.4 0.0 wez3);;;名称
(COMMAND "TEXT" "J" "MC" PT14 2.4 0.0 wez2);;;数量
(setq count (1+ count));;;计数器加1
(setq nou (itoa count));;;Returns the conversion of an integer into a string
(setq str (strcat (strcat (itoa count) "\t" wez "\t" wez2 "\t" wez3 "\t" wez4 "\t" bbh "\t" bs2 "\t" bt3)));;输出文字值，中间以空格显示
(write-line str f1);;;将str组合的结果写进文本文件f1中
);;;end repeat
;;;(write-line date3 f1)
(close f1);;关闭文件
;;;(startapp "notepad.exe" filename);;用记事本打开，并显示文件
;;;(startapp "C:/Program Files/Microsoft Office/OFFICE11/EXCEL.EXE" filename)
);;;end progn
);;;end if
(SETQ zhy (* 4 (+ count 1)))
(SETQ PT2 (polar PT1 (* -0.5 PI) zhy)
PT4 (polar PT3 (* -0.5 PI) zhy)
PT6 (polar PT5 (* -0.5 PI) zhy)
PT8 (polar PT7 (* -0.5 PI) zhy)
PT801 (polar PT701 (* -0.5 PI) zhy)
)
(COMMAND "LINE" PT1 PT2 "")
(COMMAND "LINE" PT3 PT4 "")
(COMMAND "LINE" PT5 PT6 "")
(COMMAND "LINE" PT7 PT8 "")
(COMMAND "LINE" PT701 PT801 "")
(setq wo (getstring "\n 按空格或回车键选择<输入新图框的文本字高>，按任意字母+空格/回车键选择<点选原始图框内的文字>"))
(if
(= "" wo)
(progn
(princ "\n输入新图框的文本字高<空格或回车键为当前字高>:")
(setq dqzg (Getvar "dimtxt"))
(princ "<" )
(princ dqzg )
(princ ">")
(setq dim_hl (getstring ))
(setq dim_h (atof dim_hl))
(if
(= "" dim_hl)
(setq dim_h dqzg)
)
)
(progn
(setq en (entsel "\n请点选原始图框内的文字:"))
(setq ent (entget (car en)))
(setq dim_h (cdr (assoc 40 ent)))
);;;end progn
);;;end if
(setq dim_h1 (/ dim_h 2.4))
(setq dim_h2 (rtos dim_h1 2 3))
(setq ss (lt:ss-entnext enn))
;;;(setq ss (ssget))
(command "scale" ss "" pt0 dim_h2)
(progn
;;;getword函数用法
(initget "Yes No")
(setq kw (getkword "\n完成列表并保存(Y)/<用EXCEL打开BOM列表并保存(N)>:"))
(COND
((= KW "No")
(startapp "C:/Program Files/Microsoft Office/OFFICE11/EXCEL.EXE" filename)
);;;end no
(t
(princ "\n BOM列表正在保存......")
);;;end t
);;;end cond
);;; end progn
(setvar "OSMODE" osmode_old)
(setvar "plinewid" old_PLINEWID)
(setvar "TEXTSTYLE" oldsty)
(princ "\n")
(prin1 (strcat "文件保存为XLS文件成功,路径为:" filename))
(princ);;静默退出
);;;end defun
;;; 通用函数选择集按照给定的组码值进行排序
;;;
;|;;参数说明：SE ----要排序的选择集
DXF ----排序依据的组码号
INT ----如果组码值为一个表，则INT指出使用第几个；否则nil
FUZZ----允许偏差；若无为nil
K ----T表示从大到小，nil表示从小到大
返回值：排序后的选择集
示例：(SORT-SE SS 10 0 5.0 T ) 表示按照10组码的X坐标值进行排序，允许偏差值为5.0，顺序为从大到小
(SORT-SE SS 10 1 3.0 NIL) 表示按照10组码的Y坐标值进行排序，允许偏差值为3.0，顺序为从小到大
(SORT-SE SS 8 NIL NIL NIL) 表示按照8组码值（图层名称）进行排序，顺序为从小到大
|;
(vl-load-com)
(defun SORT-SE (SE DXF INT FUZZ K / e1 e2 ent index lst newlst newse tmp)
;;建立排序列表
(setq LST '()
INDEX 0
)
(repeat (sslength SE)
(setq ENT (entget (ssname SE INDEX))
TMP (cdr (assoc DXF ENT))
)
(if (and INT
(= (type INT) 'INT)
(= (type TMP) 'list)
(< INT (length TMP))
)
(setq TMP (nth INT TMP))
)
(setq LST (cons
(list TMP (cdr (assoc 5 ENT)))
LST
)
)
(setq INDEX (1+ INDEX))
)
;;排序操作
(if (and FUZZ
(or
(= (type FUZZ) 'INT)
(= (type FUZZ) 'REAL)
)
(or
(= (type TMP) 'INT)
(= (type TMP) 'REAL)
)
)
(setq NEWLST
(vl-sort LST
(function (lambda (E1 E2)
(< (+ (car E1) FUZZ) (car E2))
)
)
)
)
(setq NEWLST
(vl-sort LST
(function (lambda (E1 E2)
(< (car E1) (car E2))
)
)
)
)
)
;;如果K为T，则倒置
(if K
(setq NEWLST (reverse NEWLST))
)
;;组织排序后的选择集
(setq NEWSE (ssadd))
(foreach TMP NEWLST
(setq NEWSE (ssadd (handent (cadr TMP)) NEWSE))
)
;;返回值
NEWSE
) ;_结束defun
;;___________________________________________
;; ▓ (lt:ss-entnext en)
;; [功能] 获取在图元 en 之后产生的图元的选择集
;; [参数] en----图元名
;; [返回] 选择集
;; [测试]1.(setq en (entlast))
;; 执行创建图元的命令，如 LINE,BOUNDARY
;; (setq ss (lt:ss-entnext en))
;; 2.(setq ss (lt:ss-entnext (car(entsel))))
(defun lt:ss-entnext (en / ss)
(if en
(progn
(setq ss (ssadd))
(while (setq en (entnext en))
(if (not (member (cdr (assoc 0 (entget en)))
'("ATTRIB" "VERTEX" "SEQEND")
)
)
(ssadd en ss)
)
)
(if (zerop (sslength ss)) (setq ss nil))
ss
)
(ssget "_x")
)
)

;;;-------------------------------------------------------- 
;;;函数：xx 
;;;-------------------------------------------------------- 
;;;编制日期:2010.11.18 
;;;编 制 者:曾敏辉 
;;;说明:本函数用以收集图纸中的BOM信息 
;;;事先在图纸中设置TEXT文字信息,并保存在相应的图层, 
;;;如文件较多,可做一模板文件，再修改相关文字即可 
;;;图层:材质,客户,数量,图号,图名,版本,版本描述 
;;;加载方法： 
;;;打开<a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a>,输入命令:ap,找到此lisp文件,点加载,关闭对话框,输入xx即可执行此命令。 
;;;或者直接将此lisp文件拉入CAD视窗即可 
;;;自动加载方法： 
;;;打开AutoCAD,输入命令:ap,点“内容...”,找到此lisp文件,点“添加”,关闭对话框,重启CAD。 
;;;以后只要输入xx就可以执行此命令。 
;;;如有问题或更好的想法请到<http://623276955.qzone.qq.com>里留言 
;;;声明:本程序旨在抛砖引玉,用于提供例子,增加实际应用功能,减轻设计者的重复用脑。 
;;; 欢迎修改,适合自己才是真正的好程序。 
;;;■【运行平台】: 
;;;Windows 2000、Windows XP 
;;;Autocad2004、Autocad2006、Autocad2007、Autocad2008、Autocad2010 
;;;-------------------------------------------------------- 
(defun c:xx( / b1 b2 b3 bb1 bb2 bb3 bbh bm1 bm2 bm3 bs2 bt1 bt2 bt3 count date0 date1 date2 date3 dim_h dim_h1 dim_h2 dim_hl dqzg dwg dwg1 en en2 en3 en4 enn ent ent2 ent3 ent4 f1 f2 filename kw minmoth n2 nou old_plinewid oldsty osmode_old p1 p2 path pt0 pt0_x pt0_y pt1 pt10 pt11 pt12 pt13 pt14 pt2 pt3 pt4 pt5 pt6 pt7 pt701 pt8 pt801 pt9 s1 s2 s3 s4 sbb scz skh sms ss ss1 ss2 ss3 ss4 ssl sth stm str wez wez2 wez3 wez4 wo zbs1 zhy) 
(SETVAR "CMDECHO" 0) 
(command "undo" "be") 
(setq osmode_old (getvar "OSMODE")) ;;捕捉设置 
(setq old_PLINEWID (getvar "PLINEWID"));;;取得pline线宽 
(setq oldsty (getvar "TEXTSTYLE"));取当前文字样式 
(setvar "plinewid" 0);;;设置当前pline线宽为0 
;;绘制表头 
(setq enn (entlast)) 
(setq pt0 (getpoint "\n请指定表格绘制位置:")) 
(setvar "OSMODE" 0) 
(setq pt0_x (car pt0) 
pt0_y (cadr pt0) 
) 
(SETQ PT1 (polar PT0 0 8) 
PT3 (polar PT1 0 8) 
PT5 (polar PT3 0 18) 
PT7 (polar PT5 0 40) 
PT701 (polar PT7 0 10) 
PT2 (polar PT1 (* -0.5 PI) 4) 
PT4 (polar PT3 (* -0.5 PI) 4) 
PT6 (polar PT5 (* -0.5 PI) 4) 
PT8 (polar PT7 (* -0.5 PI) 4) 
PT801 (polar PT701 (* -0.5 PI) 4) 
PT9 (polar PT0 (* -0.5 PI) 4) 
) 
(COMMAND "color" 7);;;内框颜色 
(COMMAND "LINE" PT1 PT701 "") 
(COMMAND "LINE" PT2 pt801 "") 
(SETQ ZBS1 (entlast))

(SETQ PT10 (polar PT0 (* -0.5 PI) (/ 4 2.0)) 
PT10 (polar PT10 0 (/ 8 2.0)) 
) 
(SETQ PT11 (polar PT10 0 (/ (+ 8 8) 2.0)) 
PT12 (polar PT11 0 (/ (+ 8 18) 2.0)) 
PT13 (polar PT12 0 10) 
PT14 (polar PT13 0 44) 
) 
(if (not (tblsearch "style" "simplex")) 
(command "_.style" "simplex" "simplex" "0" "0.8" "0" "N" "N" "N") 
) 
(if (not (tblsearch "style" "宋体")) 
(command "_.style" "宋体" "宋体" "" "" "" "" "") 
) 
(setvar "TEXTSTYLE" "宋体") 
(COMMAND "color" 7);;;文字颜色 
(COMMAND "TEXT" "J" "MC" PT11 2.4 0.0 "序号") 
(COMMAND "TEXT" "J" "MC" PT12 2.4 0.0 "图号") 
(COMMAND "TEXT" "J" "MC" (polar PT12 0 25) 2.4 0.0 "名称") 
(COMMAND "TEXT" "J" "MC" PT14 2.4 0.0 "数量") 
;;表头绘制完毕 
(princ "\n本函数用以收集图纸中的BOM信息,请选择一个范围:") 
(setq date0 (menucmd "M=$(edtime,$(getvar,date),MO)")) 
(if(= (atof date0) 1) (setq minmoth (strcat "JAN")) 
(if(= (atof date0) 2) (setq minmoth (strcat "FEB")) 
(if(= (atof date0) 3) (setq minmoth (strcat "MAR")) 
(if(= (atof date0) 4) (setq minmoth (strcat "APR")) 
(if(= (atof date0) 5) (setq minmoth (strcat "MAY")) 
(if(= (atof date0) 6) (setq minmoth (strcat "JUN")) 
(if(= (atof date0) 7) (setq minmoth (strcat "JUL")) 
(if(= (atof date0) 8) (setq minmoth (strcat "AUG")) 
(if(= (atof date0) 9) (setq minmoth (strcat "SEP")) 
(if(= (atof date0) 10) (setq minmoth (strcat "OCT")) 
(if(= (atof date0) 11) (setq minmoth (strcat "NOV")) 
(if(= (atof date0) 12) (setq minmoth (strcat "DEC")) 
))))))))))));;;结束判别 
(setq date1 (menucmd "M=$(edtime,$(getvar,date),DD)")) 
(setq date2 (menucmd "M=$(edtime,$(getvar,date),YYYY)")) 
(setq date3 (strcat minmoth "-" date1 "-" date2)) 
(setq dwg (getvar "DWGNAME") ;取当前文档名 
path (getvar "dwgprefix") ;取当前文档路径 
) 
(setq filename (strcat path dwg ".XLS")) 
(setq f1 (open filename "w"));;;并且写模式打开一文本文件， 
(setq f2 (strcat "序号" "\t" "图纸编号" "\t" "数量" "\t" "图纸名称" "\t" "材质" "\t" "版本" "\t" "版本描述" "\t" "客户" )) 
(setq dwg1 (strcat date3 "\t" "\t" dwg "--BOM表")) 
(write-line dwg1 f1);;;写文档标题在第一行 
(write-line f2 f1) 
(setq p1 (getpoint "\n第一角点 :")) 
(setq p2 (getcorner p1 "\n第二角点 :")) 
(princ "\n正在收集数据,请稍候......") 
(if (and 
(setq ss1 (ssget "W" p1 p2 '((0 . "text") (8 . "图号"))));;;过滤选择集层名为"图号"的单行文本 
(setq ss2 (ssget "W" p1 p2 '((0 . "text") (8 . "数量"))));;;过滤选择集层名为"数量"的单行文本 
(setq ss3 (ssget "W" p1 p2 '((0 . "text") (8 . "图名"))));;;过滤选择集层名为"图名"的单行文本 
(setq ss4 (ssget "W" p1 p2 '((0 . "text") (8 . "材质"))));;;过滤选择集层名为"材质"的单行文本 
(setq bb1 (ssget "W" p1 p2 '((0 . "text") (8 . "版本"))));;;过滤选择集层名为"版本"的单行文本 
(setq bb2 (ssget "W" p1 p2 '((0 . "text") (8 . "版本描述"))));;;过滤选择集层名为"版本描述"的单行文本 
(setq bb3 (ssget "W" p1 p2 '((0 . "text") (8 . "客户"))));;;过滤选择集层名为"客户"的单行文本 
);;;end and 
(progn 
(setq count 0);;;先设定基数为0 
(setq s1 (SORT-SE ss1 10 1 0.001 T));;;按照10组码的Y坐标排序(1),从上往下(T) 
(setq s2 (SORT-SE ss2 10 1 0.001 T));;;按照10组码的Y坐标排序(1),从上往下(T) 
(setq s3 (SORT-SE ss3 10 1 0.001 T));;;按照10组码的Y坐标排序(1),从上往下(T) 
(setq s4 (SORT-SE ss4 10 1 0.001 T));;;按照10组码的Y坐标排序(1),从上往下(T) 
(setq b1 (SORT-SE bb1 10 1 0.001 T));;;按照10组码的Y坐标排序(1),从上往下(T) 
(setq b2 (SORT-SE bb2 10 1 0.001 T));;;按照10组码的Y坐标排序(1),从上往下(T) 
(setq b3 (SORT-SE bb3 10 1 0.001 T));;;按照10组码的Y坐标排序(1),从上往下(T) 
(setq 
sth (sslength s1) 
ssl (sslength s2) 
stm (sslength s3) 
scz (sslength s4) 
sbb (sslength b1) 
sms (sslength b2) 
skh (sslength b3) 
) 
(princ "\n共选择文本型文字:") 
(princ "\n 图号<") 
(princ sth ) 
(princ ">个,")

(princ "\n 数量<") 
(princ ssl ) 
(princ ">个,")

(princ "\n 图名<") 
(princ stm ) 
(princ ">个,")

(princ "\n 材质<") 
(princ scz ) 
(princ ">个,")

(princ "\n 版本<") 
(princ sbb ) 
(princ ">个,")

(princ "\n 描述<") 
(princ sms ) 
(princ ">个,")

(princ "\n 客户<") 
(princ skh ) 
(princ ">个。")

(if (or (/= sth ssl ) (/= ssl stm ) (/= stm scz ) (/= scz sbb ) (/= sbb sms ) (/= sms skh ) (/= skh sth )) 
(alert "你所选择的<图号,数量,图名,材质,版本,版本描述,客户>个数不一致,请仔细检查自动生成的BOM表!或在CAD状态下按F2查看") 
) 
(repeat sth;;;依次读取选择集中每一个对象 
(setq en (ssname s1 count);;;取得选取对象的名字 
ent (entget en);;;获得对象的组码表，以便下一步提取 
);;;end setq 
(setq wez(cdr (assoc 1 ent));;;对象组码表为1，对应的是单行文字的值 
);;;end setq 
ssl;;;依次读取选择集中每一个对象 
(setq en2 (ssname s2 count);;;取得选取对象的名字 
ent2 (entget en2);;;获得对象的组码表，以便下一步提取 
);;;end setq 
(setq wez2(cdr (assoc 1 ent2));;;对象组码表为1，对应的是单行文字的值 
);;;end setq 
stm;;;依次读取选择集中每一个对象 
(setq en3 (ssname s3 count);;;取得选取对象的名字 
ent3 (entget en3);;;获得对象的组码表，以便下一步提取 
);;;end setq 
(setq wez3(cdr (assoc 1 ent3));;;对象组码表为1，对应的是单行文字的值 
);;;end setq 
scz;;;依次读取选择集中每一个对象 
(setq en4 (ssname s4 count);;;取得选取对象的名字 
ent4 (entget en4);;;获得对象的组码表，以便下一步提取 
);;;end setq 
(setq wez4(cdr (assoc 1 ent4));;;对象组码表为1，对应的是单行文字的值 
);;;end setq 
sbb;;;依次读取选择集中每一个对象 
(setq bt1(ssname b1 count);;;取得选取对象的名字 
bm1 (entget bt1);;;获得对象的组码表，以便下一步提取 
);;;end setq 
(setq bbh (cdr (assoc 1 bm1));;;对象组码表为1，对应的是单行文字的值 
);;;end setq 
sms;;;依次读取选择集中每一个对象 
(setq bt2(ssname b2 count);;;取得选取对象的名字 
bm2 (entget bt2);;;获得对象的组码表，以便下一步提取 
);;;end setq 
(setq bs2 (cdr (assoc 1 bm2));;;对象组码表为1，对应的是单行文字的值 
);;;end setq 
skh;;;依次读取选择集中每一个对象 
(setq bt3(ssname b3 count);;;取得选取对象的名字 
bm3 (entget bt3);;;获得对象的组码表，以便下一步提取 
);;;end setq 
(setq bt3 (cdr (assoc 1 bm3));;;对象组码表为1，对应的是单行文字的值 
);;;end setq 
(if (< count 10) 
(setq n2 (strcat "0" (itoa count)));;;编号一个个更改 
) 
(if (and (>= count 10) (< count 100)) 
(setq n2 (strcat (itoa count)));;;编号一个个更改 
) 
(if (>= count 100) 
(setq n2 (strcat (itoa count)));;;编号一个个更改 
) 
(setvar "OSMODE" 0) 
(COMMAND "COPY" ZBS1 "" pt0 pt9) 
(SETQ ZBS1 (entlast) 
pt11 (polar PT11 (* -0.5 PI) 4) 
pt12 (polar PT12 (* -0.5 PI) 4) 
pt13 (polar PT13 (* -0.5 PI) 4) 
pt14 (polar PT14 (* -0.5 PI) 4) 
) 
(setvar "TEXTSTYLE" "simplex") 
(COMMAND "TEXT" "J" "MC" PT11 2.4 0.0 n2);;;序号 
(COMMAND "TEXT" "J" "MC" PT12 2.4 0.0 wez);;;图号 
(setvar "TEXTSTYLE" "宋体") 
(COMMAND "TEXT" "J" "ML" PT13 2.4 0.0 wez3);;;名称 
(COMMAND "TEXT" "J" "MC" PT14 2.4 0.0 wez2);;;数量 
(setq count (1+ count));;;计数器加1 
(setq nou (itoa count));;;Returns the conversion of an integer into a string 
(setq str (strcat (strcat (itoa count) "\t" wez "\t" wez2 "\t" wez3 "\t" wez4 "\t" bbh "\t" bs2 "\t" bt3)));;输出文字值，中间以空格显示 
(write-line str f1);;;将str组合的结果写进文本文件f1中 
);;;end repeat 
;;;(write-line date3 f1) 
(close f1);;关闭文件 
;;;(startapp "notepad.exe" filename);;用记事本打开，并显示文件 
;;;(startapp "C:/Program Files/Microsoft Office/OFFICE11/EXCEL.EXE" filename) 
);;;end progn 
);;;end if 
(SETQ zhy (* 4 (+ count 1))) 
(SETQ PT2 (polar PT1 (* -0.5 PI) zhy) 
PT4 (polar PT3 (* -0.5 PI) zhy) 
PT6 (polar PT5 (* -0.5 PI) zhy) 
PT8 (polar PT7 (* -0.5 PI) zhy) 
PT801 (polar PT701 (* -0.5 PI) zhy) 
) 
(COMMAND "LINE" PT1 PT2 "") 
(COMMAND "LINE" PT3 PT4 "") 
(COMMAND "LINE" PT5 PT6 "") 
(COMMAND "LINE" PT7 PT8 "") 
(COMMAND "LINE" PT701 PT801 "") 
(setq wo (getstring "\n 按空格或回车键选择<输入新图框的文本字高>，按任意字母+空格/回车键选择<点选原始图框内的文字>")) 
(if 
(= "" wo) 
(progn 
(princ "\n输入新图框的文本字高<空格或回车键为当前字高>:") 
(setq dqzg (Getvar "dimtxt")) 
(princ "<" ) 
(princ dqzg ) 
(princ ">") 
(setq dim_hl (getstring )) 
(setq dim_h (atof dim_hl)) 
(if 
(= "" dim_hl) 
(setq dim_h dqzg) 
) 
) 
(progn 
(setq en (entsel "\n请点选原始图框内的文字:")) 
(setq ent (entget (car en))) 
(setq dim_h (cdr (assoc 40 ent))) 
);;;end progn 
);;;end if 
(setq dim_h1 (/ dim_h 2.4)) 
(setq dim_h2 (rtos dim_h1 2 3)) 
(setq ss (lt:ss-entnext enn)) 
;;;(setq ss (ssget)) 
(command "scale" ss "" pt0 dim_h2) 
(progn 
;;;getword函数用法 
(initget "Yes No") 
(setq kw (getkword "\n完成列表并保存(Y)/<用EXCEL打开BOM列表并保存(N)>:")) 
(COND 
((= KW "No") 
(startapp "C:/Program Files/Microsoft Office/OFFICE11/EXCEL.EXE" filename) 
);;;end no 
(t 
(princ "\n BOM列表正在保存......") 
);;;end t 
);;;end cond 
);;; end progn 
(setvar "OSMODE" osmode_old) 
(setvar "plinewid" old_PLINEWID) 
(setvar "TEXTSTYLE" oldsty) 
(princ "\n") 
(prin1 (strcat "文件保存为XLS文件成功,路径为:" filename)) 
(princ);;静默退出 
);;;end defun

;;; 通用函数 选择集按照给定的组码值进行排序 
;;; 
;|;;参数说明：SE ----要排序的选择集 
DXF ----排序依据的组码号 
INT ----如果组码值为一个表，则INT指出使用第几个；否则nil 
FUZZ----允许偏差；若无为nil 
K ----T表示从大到小，nil表示从小到大 
返回值：排序后的选择集 
示例：(SORT-SE SS 10 0 5.0 T ) 表示按照10组码的X坐标值进行排序，允许偏差值为5.0，顺序为从大到小 
(SORT-SE SS 10 1 3.0 NIL) 表示按照10组码的Y坐标值进行排序，允许偏差值为3.0，顺序为从小到大 
(SORT-SE SS 8 NIL NIL NIL) 表示按照8组码值（图层名称）进行排序，顺序为从小到大 
|; 
(vl-load-com) 
(defun SORT-SE (SE DXF INT FUZZ K / e1 e2 ent index lst newlst newse tmp) 
;;建立排序列表 
(setq LST '() 
     INDEX    0 
) 
(repeat (sslength SE) 
    (setq ENT (entget (ssname SE INDEX)) 
     TMP (cdr (assoc DXF ENT)) 
    ) 
    (if (and INT 
         (= (type INT) 'INT) 
         (= (type TMP) 'list) 
         (< INT (length TMP)) 
     ) 
     (setq TMP (nth INT TMP)) 
    ) 
    (setq LST (cons 
         (list TMP (cdr (assoc 5 ENT))) 
         LST 
         ) 
    ) 
    (setq INDEX (1+ INDEX)) 
) 
;;排序操作 
(if    (and FUZZ 
     (or 
         (= (type FUZZ) 'INT) 
         (= (type FUZZ) 'REAL) 
     ) 
     (or 
         (= (type TMP) 'INT) 
         (= (type TMP) 'REAL) 
     ) 
    ) 
    (setq NEWLST 
         (vl-sort LST 
             (function (lambda (E1 E2) 
                    (< (+ (car E1) FUZZ) (car E2)) 
                 ) 
             ) 
         ) 
    ) 
    (setq NEWLST 
         (vl-sort LST 
             (function (lambda (E1 E2) 
                    (< (car E1) (car E2)) 
                 ) 
             ) 
         ) 
    ) 
) 
;;如果K为T，则倒置 
(if    K 
    (setq NEWLST (reverse NEWLST)) 
) 
;;组织排序后的选择集 
(setq NEWSE (ssadd)) 
(foreach TMP NEWLST 
    (setq NEWSE (ssadd (handent (cadr TMP)) NEWSE)) 
) 
;;返回值 
NEWSE 
) ;_结束defun 
;;___________________________________________ 
;; ▓ (lt:ss-entnext en) 
;; [功能] 获取在图元 en 之后产生的图元的选择集 
;; [参数] en----图元名 
;; [返回] 选择集 
;; [测试]1.(setq en (entlast)) 
;; 执行创建图元的命令，如 LINE,BOUNDARY 
;; (setq ss (lt:ss-entnext en)) 
;; 2.(setq ss (lt:ss-entnext (car(entsel)))) 
(defun lt:ss-entnext (en / ss) 
(if en 
(progn 
(setq ss (ssadd)) 
(while (setq en (entnext en)) 
(if (not (member (cdr (assoc 0 (entget en))) 
'("ATTRIB" "VERTEX" "SEQEND") 
) 
) 
(ssadd en ss) 
) 
) 
(if (zerop (sslength ss)) (setq ss nil)) 
ss 
) 
(ssget "_x") 
) 
)

raulyazhai · 发表于 2022-3-19 10:14:40

学习一下，感谢楼主的分享

zctao1966 · 发表于 2010-11-18 20:04:00

所谓的设计就是一抄二改三创造,欢迎改进!

sooma · 发表于 2010-11-19 14:15:00

作者是高手，致敬。

yoyoho · 发表于 2010-11-20 14:56:00

感谢楼主分享程序

下载学习了!

khaki168 · 发表于 2011-6-9 13:27:21

“所谓的设计就是一抄二改三创造”，哈哈，这个说得好

wgg212 · 发表于 2011-8-13 09:07:25

这个可以有啊

alwtyp · 发表于 2011-8-13 13:17:11

BOM信息最好還是做成塊屬性。直接用eattext萃取。

zctao1966 · 发表于 2011-8-15 12:49:02

alwtyp 发表于 2011-8-13 13:17
BOM信息最好還是做成塊屬性。直接用eattext萃取。

请更改后再上传呀，主意不错！

alwtyp · 发表于 2011-8-15 21:07:48

zctao1966 发表于 2011-8-15 12:49
请更改后再上传呀，主意不错！

根本不用做程序

zctao1966 · 发表于 2011-8-16 12:39:11

alwtyp 发表于 2011-8-15 21:07
根本不用做程序

可不可以提取打开的CAD文档中指定范围内的数据？
请上传一张eattext命令的用法gif图，我的CAD好像是用不了，
谢谢！

账号		自动登录	找回密码
密码			注册

[原创]CAD中收集图纸中存在的BOM信息

本帖子中包含更多资源

点评

评分

点评

评分