总结Pa的具体数据
好的，伙计们，这就是我要找的，我想写一个lisp或修改现有的lisp，它将在给定的选择框架内选择块，并在图形或excel文件中总结表中的属性数据。我找到了LeeMac的很棒的程序“计算属性值”，但我的问题是，现在它仍然在我的脑海中，所以我很难理解它。此外，我想将其限制为具有特定名称的块，然后在该块中仅总结一个特定属性，因为这些块具有计数属性，这是不必要的。
如果有人能给我一些指导或我可以在此基础上建立的东西，我将不胜感激。
此外，我知道EATTEXT可以做到这一点，但我正在寻找更快的东西。 ;;-----------------=={ Count Attribute Values }==-------------;;
;; ;;
;;Counts the number of occurrences of attribute values in a ;;
;;selection of attributed blocks. Displays result in an ;;
;;AutoCAD Table object. ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
(defun c:CAV nil (c:CountAttributeValues))
(defun c:CountAttributeValues ( / _Dxf _Assoc++ _SumAttributes s ss i e alist bnlist attlist)
(setq bnlist '("BN1" "BN2" "BN3") ;; BLOCK NAME HERE
attlist '("ATT1" "ATT2" "ATT3" "ATT4") ;; ATTRIBUTES HERE
)
(defun _Dxf ( key alist ) (cdr (assoc key alist)))
(defun _Assoc++ ( key alist )
(
(lambda ( pair )
(if pair
(subst (list key (1+ (cadr pair))) pair alist)
(cons(list key 1) alist)
)
)
(assoc key alist)
)
)
(defun _SumAttributes ( entity alist / eqlist)
(while
(not
(eq "SEQEND"
(_dxf 0
(entget
(setq entity
(entnext entity)
)
)
)
)
)
(setq alist (_Assoc++ (_Dxf 1 (reverse (entget entity))) alist))
)
(setq alist(vl-remove-if (function (lambda (a) (not (member (car a) attlist)))) alist))
)
(if
(setq s (ssget '((0 . "INSERT") (66 . 1))))
(progn
(setq ss (ssadd))
(repeat
(setq i (sslength s))
(if
(member
(vla-get-effectivename
(vlax-ename->vla-object
(setq e
(ssname s
(setq i (1- i))
)
)
)
)
bnlist
)
(ssadd e ss))
)
(cond
(
(not
(vlax-method-applicable-p
(setq space
(vlax-get-property
(setq doc
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)
)
)
'AddTable
)
)
(princ "\n** This Version of AutoCAD Does not Support Tables **")
)
(
(and
(repeat (setq i (sslength ss))
(setq alist (_SumAttributes (ssname ss (setq i (1- i))) alist))
)
(setq pt (getpoint "\nPick Point for Table: "))
)
(LM:AddTable space (trans pt 1 0) "Attribute Totals"
(cons '("Value" "Total")
(vl-sort
(mapcar
(function
(lambda ( pair )
(list (car pair) (itoa (cadr pair)))
)
)
alist
)
(function (lambda ( a b ) (< (strcase (car a)) (strcase (car b)))))
)
)
)
)
))
)
(princ)
)
;;---------------------=={ Add Table }==----------------------;;
;; ;;
;;Creates a VLA Table Object at the specified point, ;;
;;populated with title and data ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;space - VLA Block Object ;;
;;pt - Insertion Point for Table ;;
;;title - Table title ;;
;;data- List of data to populate the table ;;
;;------------------------------------------------------------;;
;;Returns:VLA Table Object ;;
;;------------------------------------------------------------;;
(defun LM:AddTable ( space pt title data / _itemp ) (vl-load-com)
(defun _itemp ( collection item )
(if
(not
(vl-catch-all-error-p
(setq item
(vl-catch-all-apply 'vla-item (list collection item))
)
)
)
item
)
)
(
(lambda ( table ) (vla-put-StyleName table (getvar 'CTABLESTYLE)) (vla-SetText table 0 0 title)
(
(lambda ( row )
(mapcar
(function
(lambda ( rowitem ) (setq row (1+ row))
(
(lambda ( column )
(mapcar
(function
(lambda ( item )
(vla-SetText table row
(setq column (1+ column)) item
)
)
)
rowitem
)
)
-1
)
)
)
data
)
)
0
)
table
)
(
(lambda ( textheight )
(vla-AddTable space (vlax-3D-point pt) (1+ (length data)) (length (car data)) (* 1.8 textheight)
(* textheight
(apply 'max
(cons (/ (strlen title) (length (car data)))
(mapcar 'strlen (apply 'append data))
)
)
)
)
)
(vla-getTextHeight
(_itemp
(_itemp
(vla-get-Dictionaries
(vla-get-ActiveDocument (vlax-get-acad-object))
)
"ACAD_TABLESTYLE"
)
(getvar 'CTABLESTYLE)
)
acDataRow
)
)
)
)
(princ) 谢谢Jdiala，
尝试了两种不同的方法，但都没有成功。没有出错，只是在我选择对象后什么都不做。反复检查我是否有正确的块名和属性几次。 我修改了上面的代码。
对不起，李把你的代码弄乱了。如果不使用另一个选择集，则无法找到它。 它对你有用吗？我还是没有一张桌子。 是的，它确实对我有用。你能寄一张样图吗。 那太好了。。。我可能在做一些愚蠢的事。
您的代码和我的块名：CountAttributeValuesALT1。lsp
我的测试图：测试摘录。图纸 对不起，我的错。我以为你想计算属性值。
试试这个。
;;-----------------=={ Count Attribute Values }==-------------;;
;; ;;
;;Counts the number of occurrences of attribute values in a ;;
;;selection of attributed blocks. Displays result in an ;;
;;AutoCAD Table object. ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
(defun c:CAV nil (c:CountAttributeValues))
(defun c:CountAttributeValues ( / _Dxf _Assoc++ _SumAttributes s ss i ebnlist alist att)
(setq bnlist '("KIT-ID" "KITID") ;; BLOCK NAME HERE
att "XXXX" ;;; atribute here
)
(defun _Dxf ( key alist ) (cdr (assoc key alist)))
(defun _Assoc++ ( key alist )
(
(lambda ( pair )
(if pair
(subst (list key (1+ (cadr pair))) pair alist)
(cons(list key 1) alist)
)
)
(assoc key alist)
)
)
(defun LM:vl-getattributes ( blk )
(mapcar '(lambda ( att ) (cons (vla-get-tagstring att) (vla-get-textstring att)))
(vlax-invoke blk 'getattributes)
)
)
(defun _SumAttributes ( entity alist)
(while
(not
(eq "SEQEND"
(_dxf 0
(entget
(setq entity
(entnext entity)
)
)
)
)
)
(setq alist
(vl-remove-if
(function
(lambda (a)
(and
(not
(= att
(vla-get-tagstring
(vlax-ename->vla-object entity)
)
)
)
(eq
(cdr
(assoc 1
(entget entity)
)
)
(car a)
)
)
)
)
(_Assoc++
(_Dxf 1
(reverse
(entget entity)
)
)
alist
)
)
)
)
)
(if
(setq s (ssget '((0 . "INSERT") (66 . 1))))
(progn
(setq ss (ssadd))
(repeat
(setq i (sslength s))
(if
(member
(vla-get-effectivename
(vlax-ename->vla-object
(setq e
(ssname s
(setq i (1- i))
)
)
)
)
bnlist
)
(ssadd e ss))
)
(cond
(
(not
(vlax-method-applicable-p
(setq space
(vlax-get-property
(setq doc
(vla-get-ActiveDocument (vlax-get-acad-object))
)
(if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace)
)
)
'AddTable
)
)
(princ "\n** This Version of AutoCAD Does not Support Tables **")
)
(
(and
(repeat (setq i (sslength ss))
(setq alist (_SumAttributes (ssname ss (setq i (1- i))) alist))
)
(setq pt (getpoint "\nPick Point for Table: "))
(princ alist)
)
(LM:AddTable space (trans pt 1 0) "Attribute Totals"
(cons '("Value" "Total")
(vl-sort
(mapcar
(function
(lambda ( pair )
(list (car pair) (itoa (cadr pair)))
)
)
alist
)
(function (lambda ( a b ) (< (strcase (car a)) (strcase (car b)))))
)
)
)
)
))
)
(princ)
)
;;---------------------=={ Add Table }==----------------------;;
;; ;;
;;Creates a VLA Table Object at the specified point, ;;
;;populated with title and data ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;space - VLA Block Object ;;
;;pt - Insertion Point for Table ;;
;;title - Table title ;;
;;data- List of data to populate the table ;;
;;------------------------------------------------------------;;
;;Returns:VLA Table Object ;;
;;------------------------------------------------------------;;
(defun LM:AddTable ( space pt title data / _itemp ) (vl-load-com)
(defun _itemp ( collection item )
(if
(not
(vl-catch-all-error-p
(setq item
(vl-catch-all-apply 'vla-item (list collection item))
)
)
)
item
)
)
(
(lambda ( table ) (vla-put-StyleName table (getvar 'CTABLESTYLE)) (vla-SetText table 0 0 title)
(
(lambda ( row )
(mapcar
(function
(lambda ( rowitem ) (setq row (1+ row))
(
(lambda ( column )
(mapcar
(function
(lambda ( item )
(vla-SetText table row
(setq column (1+ column)) item
)
)
)
rowitem
)
)
-1
)
)
)
data
)
)
0
)
table
)
(
(lambda ( textheight )
(vla-AddTable space (vlax-3D-point pt) (1+ (length data)) (length (car data)) (* 1.8 textheight)
(* textheight
(apply 'max
(cons (/ (strlen title) (length (car data)))
(mapcar 'strlen (apply 'append data))
)
)
)
)
)
(vla-getTextHeight
(_itemp
(_itemp
(vla-get-Dictionaries
(vla-get-ActiveDocument (vlax-get-acad-object))
)
"ACAD_TABLESTYLE"
)
(getvar 'CTABLESTYLE)
)
acDataRow
)
)
)
)
(princ)
页:
[1]