Lisp使用块创建bom表
我试图找出一个LISP来创建一个包含属性块的BOM表。我的公司目前使用“BOM提取器”应用程序，这是好的，我希望它有唯一的事情是创建不同的文本高度的样式保存在应用程序中，而不是所有我要做的是选择我需要的样式与保存的文本高度插入到绘图中。我偶然发现了一条2010年的帖子(http://www.cadtutor.net/forum/showthread.php?54412-制作一个bom表（making-a-bom-list-from-blocks-with-attributes），这是我正在寻找的，除了启动lisp命令并插入表格时，它会带来bom表中不需要的属性的其他部分。有人能帮我“tweek”Lisp程序，我需要它吗？标题和列需要类似于图2。第一张照片是当我试着自己用Lisp程序的Lisp程序的时候，结果是这样的。
您需要发布lisp代码和样例dwg。所有的海报块都是不同的，所以很难做到一个代码就能做到所有。
不用深入讨论，有一种方法可以在不知道其标记名的情况下读取块属性，并将其放入表的正确列中。 对不起，这个帖子真的很新。在做了更多的研究后，我从李·麦克那里找到了这段代码，这段代码非常精彩：
(defun c:bnum ( / *error* mutter ss doc )
;; © Lee Mac~05.06.10
(defun *error* ( msg )
(and mutter (setvar 'nomutt mutter))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(or *title (setq *title "Block Data"))
(or *prev(setq *prev"ON"))
(setq mutter (getvar 'nomutt))
(setvar 'nomutt 1)
(princ "\nSelect Blocks to Count <All> : ")
(cond ((not (progn (setq ss (cond ((ssget '((0 . "INSERT"))))
((ssget "_X" '((0 . "INSERT"))))))
(setvar 'nomutt mutter) ss))
(princ "\n** No Blocks Found **")
)
(
(_DisplayResult
(mapcar
(function
(lambda ( x ) (list (car x) (itoa (cadr x))))
)
(
(lambda ( / l n )
(vlax-for obj
(setq ss
(vla-get-ActiveSelectionSet
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
)
)
(if (zerop (logand 45 (cdr (assoc 70 (tblsearch "BLOCK" (setq n (BlockName obj)))))))
(setq l (assoc++ n l))
)
)
l
)
)
)
)
)
((princ "\n** No Blocks Found **"))
)
(princ)
)
(defun _DisplayResult ( lst / rLen )
(if lst
(progn
(setq rLen
(+ 3
(apply (function max)
(cons 5
(mapcar (function strlen)
(mapcar (function cadr) lst)
)
)
)
)
)
(mapcar
(function
(lambda ( item )
(princ
(strcat "\n"
(PadRight (TidyString (caritem) 40) "." 40) "|"
(PadLeft(cadr item) "." rLen)
)
)
)
)
(append
(list '("MANUFACTURER_NUMBER" "QUANTITY")
(list (PadRight "" "-" 40) (PadLeft"" "-" rLen))
)
(setq lst
(vl-sort lst
(function
(lambda ( a b ) (< (car a) (car b)))
)
)
)
(list
(list (PadRight "" "-" 40) (PadLeft "" "-" rLen))
)
)
)
(terpri)
(if (> (atof (getvar 'ACADVER)) 16.)
(progn
(while
(progn
(initget "Yes No Settings")
(setq choix (getkword "\nTable? <Yes> : "))
(cond ((or (not choix) (eq "Yes" choix))
(GrMove
(AddTable
(GetActiveSpace
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
(getvar 'VIEWCTR) *title
(cons '("Block Name" "Count") lst)
(eq "ON" *prev)
)
'InsertionPoint "\nPlace Table... " 0
)
nil
)
((eq "Settings" choix)
(while
(progn
(initget "Title Preview Exit")
(princ (strcat "\n<< Title: " (if (eq "" *title) "-None-" *title) ", Block Preview: " *prev " >>"))
(setq subchoix (getkword "\nEdit Settings <Exit> : "))
(cond ((or (not subchoix) (eq "Exit" subchoix)) nil)
((eq "Title" subchoix)
(setq *title (getstring t "\nSpecify Table Title or <Enter> for None: "))
)
(t (initget "ON OFF")
(setq *prev (cond ((getkword "\nBlock Preview Setting <ON> : ")) ("ON")))
)
)
)
)
t
)
((textscr))
)
)
)
t
)
(not (textscr))
)
)
)
)
(defun assoc++ ( key lst )
(
(lambda ( pair )
(cond
( pair
(subst (list (car pair) (1+ (cadr pair))) pair lst)
)
( (cons (list key 1) lst) )
)
)
(assoc key lst)
)
)
(defun Is64Bit nil
(vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
)
(defun BlockName ( obj )
(vlax-get-property obj
(if (vlax-property-available-p obj 'EffectiveName)
'EffectiveName 'Name
)
)
)
(defun GetActiveSpace ( doc )
(vlax-get-property doc
(if (or (eq acModelSpace (vla-get-ActiveSpace doc))
(eq :vlax-true (vla-get-MSpace doc)))
'ModelSpace 'PaperSpace
)
)
)
(defun GetObjectID ( obj doc )
(if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE")))
(vlax-invoke-method (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false)
(itoa (vla-get-Objectid obj))
)
)
(defun Itemp ( coll item )
(if
(not
(vl-catch-all-error-p
(setq item
(vl-catch-all-apply
(function vla-item) (list coll item)
)
)
)
)
item
)
)
(defun AddTable ( block pt title data preview / blks doc tObj tStyle )
(setq tStyle (GetTableStyle (getvar 'CTABLESTYLE)))
(vlax-put-property
(setq tObj
(vla-AddTable block
(vlax-3D-point pt) (1+ (length data))
(+ (if preview 1 0) (length (car data)))
(* 1.8 (vla-getTextHeight tStyle acDataRow))
(* 0.8
(apply (function max)
(mapcar (function strlen)
(apply (function append) data)
)
)
(vla-getTextHeight tStyle acDataRow)
)
)
)
'StyleName (getvar 'CTABLESTYLE)
)
(vla-put-RegenerateTableSuppressed tObj :vlax-true)
(setq blks
(vla-get-blocks
(setq doc
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
)
)
(if preview
(progn
(vla-SetText tObj 1 0 "Preview")
(
(lambda ( row )
(mapcar
(function
(lambda ( block ) (setq row (1+ row))
(vla-SetCellType tObj row 0 acBlockCell)
(vla-SetBlockTableRecordId tObj row 0
(GetObjectID (Itemp blks block) doc) t
)
)
)
(mapcar (function car) (cdr data))
)
)
1
)
)
)
(
(lambda ( row )
(mapcar
(function
(lambda ( rowitem ) (setq row (1+ row))
(
(lambda ( column )
(mapcar
(function
(lambda ( item )
(vla-SetText tObj row
(setq column (1+ column)) item
)
)
)
rowitem
)
)
(if preview 0 -1)
)
)
)
data
)
)
0
)
(if (eq "" title)
(vla-deleterows tObj 0 1)
(vla-SetText tObj 0 0 title)
)
(vla-put-RegenerateTableSuppressed tObj :vlax-false)
tObj
)
(defun GetTableStyle ( Name )
(if (setq Dict
(Itemp
(vla-get-Dictionaries
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
"ACAD_TABLESTYLE"
)
)
(Itemp Dict Name)
)
)
(defun GrMove ( obj prop msg cur / *error* gr data )
(defun *error* ( msg )
(and obj (not (vlax-erased-p obj)) (vla-delete obj))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(if (vlax-property-available-p obj prop)
(progn
(princ msg)
(while
(and (= 5 (car (setq gr (grread t 13 cur))))
(listp (setq data (cadr gr))))
(vlax-put-property obj prop (vlax-3D-point data))
)
data
)
)
)
(defun TidyString ( str len )
(if (> (strlen str) len)
(strcat (substr str 1 (- len 3)) "...") str
)
)
(defun PadRight ( str char len )
(while (< (strlen str) len)
(setq str (strcat str char))
)
str
)
(defun PadLeft ( str char len )
(while (< (strlen str) len)
(setq str (strcat char str))
)
str
)
(princ "\nø¤º°`°º¤øCount.lsp ~ Copyright © by Lee McDonnellø¤º°`°º¤ø")
(princ "\n ~¤~ ...Type \"Count\" to Invoke... ~¤~ ")
(princ)
;;;¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,;;;
;; ;;
;; End of Program Code ;;
;; ;;
;;;ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,¤º°`°º¤;;;
我想出了如何创建更多我需要的列，并根据需要命名。现在唯一的问题是我需要编辑代码，从动态块中读取属性，并将信息放入正确的列中。我知道它只是执行dataextraction命令，但这需要很长时间。我附上了一个简单的dwg测试BOM表。如果有人能帮我（非常感谢）几个动态块。此外，这是我的更改代码，用于按顺序添加列（如果有帮助的话？）
(defun c:BC ( / *error* mutter ss doc )
;; © Lee Mac~05.06.10
(defun *error* ( msg )
(and mutter (setvar 'nomutt mutter))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(or *title (setq *title "Block Data"))
(or *prev(setq *prev"ON"))
(setq mutter (getvar 'nomutt))
(setvar 'nomutt 1)
(princ "\nSelect Blocks to Count <All> : ")
(cond ((not (progn (setq ss (cond ((ssget '((0 . "INSERT"))))
((ssget "_X" '((0 . "INSERT"))))))
(setvar 'nomutt mutter) ss))
(princ "\n** No Blocks Found **")
)
(
(_DisplayResult
(mapcar
(function
(lambda ( x ) (list (car x) (itoa (cadr x))))
)
(
(lambda ( / l n )
(vlax-for obj
(setq ss
(vla-get-ActiveSelectionSet
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
)
)
(if (zerop (logand 45 (cdr (assoc 70 (tblsearch "BLOCK" (setq n (BlockName obj)))))))
(setq l (assoc++ n l))
)
)
l
)
)
)
)
)
((princ "\n** No Blocks Found **"))
)
(princ)
)
(defun _DisplayResult ( lst / rLen )
(if lst
(progn
(setq rLen
(+ 3
(apply (function max)
(cons 5
(mapcar (function strlen)
(mapcar (function cadr) lst)
)
)
)
)
)
(mapcar
(function
(lambda ( item )
(princ
(strcat "\n"
(PadRight (TidyString (caritem) 40) "." 40) "|"
(PadLeft(cadr item) "." rLen)
)
)
)
)
(append
(list '("ID" "MANUFACTURER" "PART NUMBER" "DESCRIPTION" "QUANTITY")
(list (PadRight "" "-" 40) (PadLeft"" "-" rLen))
)
(setq lst
(vl-sort lst
(function
(lambda ( a b ) (< (car a) (car b)))
)
)
)
(list
(list (PadRight "" "-" 40) (PadLeft "" "-" rLen))
)
)
)
(terpri)
(if (> (atof (getvar 'ACADVER)) 16.)
(progn
(while
(progn
(initget "Yes No Settings")
(setq choix (getkword "\nTable? <Yes> : "))
(cond ((or (not choix) (eq "Yes" choix))
(GrMove
(AddTable
(GetActiveSpace
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
(getvar 'VIEWCTR) *title
(cons '("ID" "MANUFACTURER" "PART NUMBER" "DESCRIPTION" "QUANTITY") lst)
(eq "ON" *prev)
)
'InsertionPoint "\nPlace Table... " 0
)
nil
)
((eq "Settings" choix)
(while
(progn
(initget "Title Preview Exit")
(princ (strcat "\n<< Title: " (if (eq "" *title) "-None-" *title) ", Block Preview: " *prev " >>"))
(setq subchoix (getkword "\nEdit Settings <Exit> : "))
(cond ((or (not subchoix) (eq "Exit" subchoix)) nil)
((eq "Title" subchoix)
(setq *title (getstring t "\nSpecify Table Title or <Enter> for None: "))
)
(t (initget "ON OFF")
(setq *prev (cond ((getkword "\nBlock Preview Setting <ON> : ")) ("ON")))
)
)
)
)
t
)
((textscr))
)
)
)
t
)
(not (textscr))
)
)
)
)
(defun assoc++ ( key lst )
(
(lambda ( pair )
(cond
( pair
(subst (list (car pair) (1+ (cadr pair))) pair lst)
)
( (cons (list key 1) lst) )
)
)
(assoc key lst)
)
)
(defun Is64Bit nil
(vl-string-search "64" (getenv "PROCESSOR_ARCHITECTURE"))
)
(defun BlockName ( obj )
(vlax-get-property obj
(if (vlax-property-available-p obj 'EffectiveName)
'EffectiveName 'Name
)
)
)
(defun GetActiveSpace ( doc )
(vlax-get-property doc
(if (or (eq acModelSpace (vla-get-ActiveSpace doc))
(eq :vlax-true (vla-get-MSpace doc)))
'ModelSpace 'PaperSpace
)
)
)
(defun GetObjectID ( obj doc )
(if (eq "X64" (strcase (getenv "PROCESSOR_ARCHITECTURE")))
(vlax-invoke-method (vla-get-Utility doc) 'GetObjectIdString obj :vlax-false)
(itoa (vla-get-Objectid obj))
)
)
(defun Itemp ( coll item )
(if
(not
(vl-catch-all-error-p
(setq item
(vl-catch-all-apply
(function vla-item) (list coll item)
)
)
)
)
item
)
)
(defun AddTable ( block pt title data preview / blks doc tObj tStyle )
(setq tStyle (GetTableStyle (getvar 'CTABLESTYLE)))
(vlax-put-property
(setq tObj
(vla-AddTable block
(vlax-3D-point pt) (1+ (length data))
(+ (if preview 1 0) (length (car data)))
(* 1.8 (vla-getTextHeight tStyle acDataRow))
(* 0.8
(apply (function max)
(mapcar (function strlen)
(apply (function append) data)
)
)
(vla-getTextHeight tStyle acDataRow)
)
)
)
'StyleName (getvar 'CTABLESTYLE)
)
(vla-put-RegenerateTableSuppressed tObj :vlax-true)
(setq blks
(vla-get-blocks
(setq doc
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
)
)
(if preview
(progn
(vla-SetText tObj 1 0 "Preview")
(
(lambda ( row )
(mapcar
(function
(lambda ( block ) (setq row (1+ row))
(vla-SetCellType tObj row 0 acBlockCell)
(vla-SetBlockTableRecordId tObj row 0
(GetObjectID (Itemp blks block) doc) t
)
)
)
(mapcar (function car) (cdr data))
)
)
1
)
)
)
(
(lambda ( row )
(mapcar
(function
(lambda ( rowitem ) (setq row (1+ row))
(
(lambda ( column )
(mapcar
(function
(lambda ( item )
(vla-SetText tObj row
(setq column (1+ column)) item
)
)
)
rowitem
)
)
(if preview 0 -1)
)
)
)
data
)
)
0
)
(if (eq "" title)
(vla-deleterows tObj 0 1)
(vla-SetText tObj 0 0 title)
)
(vla-put-RegenerateTableSuppressed tObj :vlax-false)
tObj
)
(defun GetTableStyle ( Name )
(if (setq Dict
(Itemp
(vla-get-Dictionaries
(vla-get-ActiveDocument
(vlax-get-acad-object)
)
)
"ACAD_TABLESTYLE"
)
)
(Itemp Dict Name)
)
)
(defun GrMove ( obj prop msg cur / *error* gr data )
(defun *error* ( msg )
(and obj (not (vlax-erased-p obj)) (vla-delete obj))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)
)
(if (vlax-property-available-p obj prop)
(progn
(princ msg)
(while
(and (= 5 (car (setq gr (grread t 13 cur))))
(listp (setq data (cadr gr))))
(vlax-put-property obj prop (vlax-3D-point data))
)
data
)
)
)
(defun TidyString ( str len )
(if (> (strlen str) len)
(strcat (substr str 1 (- len 3)) "...") str
)
)
(defun PadRight ( str char len )
(while (< (strlen str) len)
(setq str (strcat str char))
)
str
)
(defun PadLeft ( str char len )
(while (< (strlen str) len)
(setq str (strcat char str))
)
str
)
(princ "\nø¤º°`°º¤øCount.lsp ~ Copyright © by Lee McDonnellø¤º°`°º¤ø")
(princ "\n ~¤~ ...Type \"Count\" to Invoke... ~¤~ ")
(princ)
;;;¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,;;;
;; ;;
;; End of Program Code ;;
;; ;;
;;;ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,ø¤º°`°º¤ø,¸¸,¤º°`°º¤;;; 该代码看起来是我的块计数器应用程序的前身。 天哪，李，我认为在2010年做这样的代码是远远超过令人印象深刻！
你在论坛上几乎没有留下任何学习曲线的痕迹——我只能找到2008-9年的两条帖子，在那里你可以问一些问题。 李，
有没有办法通过计数设置添加更多我需要的列？ 数据提取命令只需要很长时间即可设置并根据需要进行精确调整。设置好后，创建一个模板，将所有内容放置到位。然后，只需简单的刷新即可。如果精心设置，使用经过深思熟虑的块和属性，数据提取实际上会非常强大。
-TZ公司 嗨，胡羽毛，
PM我，如果你想我写一个完整的程序为您的要求，如本线程中所述。
不是当前版本-请参阅我对您通过我的网站发布的电子邮件的回复。 塔尔瓦特，
我还不能发送一个下午，因为我还没有访问权限？关于所需数量的帖子？
页:
[1]
2