求填充图案面积，请大师赐教，感谢！

相信自己666

求填充图案面积，我论坛里找到个程序，可是统计出来的结果不正确，麻烦大师给看看解决下，请大师赐教，感谢！
(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))

Lisphk

那就是你画的填充有问题，你看看有没有用 特性管理器查看，面积为0的填充？

Lisphk

第二个填充有面积，面积计算是正确的




第一个填充，你画的有问题，CAD自身看不到面积

相信自己666

Lisphk 发表于 2020-4-8 08:20
第二个填充有面积，面积计算是正确的

老师，完整的填充可以计算出来，是不是填充的图案里不能有其他图形啊？这个插件能不能改下？请老师赐教，感谢！

pxr201419

还真是有趣，当圆和矩形的边相切，“选择对象”方式产生的填充，特性栏显示面积，“拾取点”方式产生的填充，特性栏不显示面积

Lisphk

pxr201419 发表于 2020-4-8 11:17
还真是有趣，当圆和矩形的边相切，“选择对象”方式产生的填充，特性栏显示面积，“拾取点”方式产生的填充 ...

相切也是自交， 边界只要自交，填充就没面积

Lisphk

相信自己666 发表于 2020-4-8 09:10
老师，完整的填充可以计算出来，是不是填充的图案里不能有其他图形啊？这个插件能不能改下？请老师赐教， ...

画填充的时候，边界别自交， 你的图，下面的几个园和边界相切了，在内部别相切就行了，

pxr201419

Lisphk 发表于 2020-4-8 12:45
相切也是自交， 边界只要自交，填充就没面积

多谢老师指点，这种情况如何取得它的面积呢？

Lisphk

pxr201419 发表于 2020-4-8 13:01
多谢老师指点，这种情况如何取得它的面积呢？

避免这样画图，用替代的方法画

相信自己666

Lisphk 发表于 2020-4-8 13:34
避免这样画图，用替代的方法画

老师，画这种图通常都是这样画的，能不能上面那个lsp程序基础上做调整啊？