增强的填充面积统计报表插件
强大的填充面积统计工具，可以根据模式，图层，颜色分类统计并生成图例及统计结果。(defun c:XDTB_TJHATCH (/ blk clr e ha hascl head height keyword ln lst lyr
mode name pt row scl ss str tarea tb x y
)
(defun _prompt ()
(xdrx_prompt "\n统计方式：按*" (cond
((= #mode 0)
(setq head (list "图例" "图层"
"数 量" "总面积"
)
)
"图层"
)
((= #mode 1)
(setq head (list "图例" "颜色号"
"数 量" "总面积"
)
)
"颜色"
)
(t
(setq head (list "图例" "模式"
"数 量" "总面积"
)
)
"模式"
)
) "*"
)
)
(defun _keyword (keyword)
(cond
((= keyword "TC")
(setq #mode 0)
)
((= keyword "YS")
(setq #mode 1)
)
(t
(setq #mode 2)
)
)
(_prompt)
)
(defun _name (x mode)
(cond
((= mode "layer")
(car (xdrx_getpropertyvalue x mode))
)
((= mode "color")
(setq ln (xdrx_getpropertyvalue x mode))
(if (= ln 256)
(progn
(setq lyr (cadr (xdrx_getpropertyvalue x "layer")))
(xdrx_getpropertyvalue lyr "color")
)
ln
)
)
(t
(xdrx_getpropertyvalue x mode)
)
)
)
(defun _maketuli (clr mode)
(setq e (xdrx_polyline_make (xd::pnt:getrecpnts '(0 0 0) (* scl 10.)
(* 5 scl)
) t
)
)
(xdrx_setpropertyvalue e "constantwidth" (* scl 0.3) "color" 7)
(setq ha (xdrx_hatch_make e))
(xdrx_setpropertyvalue ha "color" clr "patternname" mode)
(setq name (xdrx_prompt "XD-TJ-HA-" mode "-" clr t))
(if (not (setq blk (xdrx_object_get "block" name)))
(progn
(xdrx_block_make (strcase name) (list e ha) '(0 0 0.) t)
(xdrx_entity_delete (entlast))
(setq blk (xdrx_object_get "block" name))
(xdrx_draworder->back (setq ha (car (xdrx_block_getentities blk '
(
(0 . "HATCH")
)
)
)
)
)
(if (= #mode 2)
(progn
(setq hascl (XD::Hatch:GetSclByGap mode (* 1.414 scl)))
(xdrx_setpropertyvalue ha "PatternScale" hascl "patternname"
(list 1 mode)
)
)
)
)
)
blk
)
(defun _makelst (ss mode)
(setq lst (mapcar
'(lambda (x)
(list (_name x mode) x)
)
(xdrx_pickset->ents ss)
)
)
)
(defun _getHa (str)
(cond
((= #mode 0)
(setq e (ssget "x" (list (cons 8 str) '(0 . "HATCH")))
e (ssname e 0)
clr (xdrx_getpropertyvalue e "color" t)
)
(_makeTuLi clr "SOLID")
)
((= #mode 1)
(_makeTuLi str "SOLID")
)
(t
(setq e (ssget "x" (list (cons 2 str)))
e (ssname e 0)
clr (xdrx_getpropertyvalue e "color" t)
)
(_makeTuLi clr str)
)
)
)
(defun _data ()
(cond
((= #mode 0)
(setq lst (_makelst ss "layer"))
)
((= #mode 1)
(setq lst (_makelst ss "color"))
)
(t
(setq lst (_makelst ss "patternname"))
)
)
(setq lst (xd::list:groupbyindex lst 1e-3)
lst (vl-sort lst '(lambda (x y)
(< (car x) (car y))
)
)
lst (mapcar
'(lambda (x)
(list (_getHa (car x)) (car x) (length (cdr x))
(rtos (apply
'+
(mapcar
'(lambda (y)
(xdrx_getpropertyvalue y "area")
)
(cdr x)
)
) 2 1
)
)
)
lst
)
lst (cons head lst)
lst (cons (list "填充面积统计表" "" "" "") lst)
tarea (mapcar
'last
lst
)
tarea (apply
'+
(mapcar
'atof
(cddr tarea)
)
)
lst (append
lst
(list (list "" "合计" "" (rtos tarea 2 1)))
)
)
)
(defun _table ()
(if (setq pt (getpoint "\n表格插入点<退出>:"))
(progn
(xd::text:init 1)
(setq tb (XD::Table:MakeFromList lst pt #height (/ #height 2.0)))
(setq row (1- (length lst)))
(xdrx_table_MergeCells tb row row 0 1)
(xdrx_table_SetTextString tb row 0 "合 计")
(xdrx_setpropertyvalue tb "color" 7)
)
)
)
(xdrx_begin)
(xdrx_sysvar_push '("dimzin" 0))
(if (not #mode)
(setq #mode 0)
)
(if (not #height)
(setq #height 4.)
)
(setq scl (* (xd::var:getratio) (xd::var:getscaleratio)))
(if (setq height (getreal (strcat (xdrx_prompt "\n表格字高<" #height ">:"
t
)
)
)
)
(setq #height height)
)
(if (and
(_prompt)
(xdrx_initssget "\n选取要统计的填充[图层(TC)/颜色(YS)/模式(MS)]<退出>:"
"TC YS MS" "移除不统计的填充[添加(A)]<退出>:"
"_keyword" ""
)
(setq ss (xdrx_ssget '((0 . "HATCH"))))
)
(progn
(setq lst (_data))
(_table)
)
)
(xdrx_sysvar_pop)
(xdrx_end)
(princ)
)
看了gif，确实非常强悍 本帖最后由 liuyj 于 2016-10-31 23:15 编辑
越来越贵了 liuyj 发表于 2016-10-31 23:13
你都1万5千个豆了，不花做什么啊。
回覆学习,强大的填充面积统计工具!!!!! 珍惜生命，果断回帖。 啥也不说了，感谢楼主分享哇！ 谢谢分享{:1_1:}{:1_1:}{:1_1:} 我来测试一下，行不行
啥也不说了，感谢楼主分享哇！ 谢谢楼主分享，看看 正需要，支持楼主大人了！ 学习大神们的作品！
求**！ 好插件太多了