[编程申请]：求大侠优化面积计算程序

wjj992

我有一个按填充图案名称分别计算各图案名填充面积的程序，也是在一个社区编程申请中求来的，非常感谢那位大侠。
但在实际应用中还有一些小问题，有些填充图案本身没有面积，如果框选到这个图案，就会出现“命令: cs
选择对象: 指定对角点: 找到 228 个
选择对象:
建模操作错误:
     操作失败。
Automation 错误。 输入无效”
的问题，
且该程序可计算的图案计算完之后以虚线表示，不能计算的话就全部没动静，如果填充图案太多的话就找不到那些图案是没有面积的。
请求那位大侠能优化一下这个程序，增加自动过滤掉这些计算不了的图案，只计算可以计算的图案面积，计算完后可以删除掉可以计算的图案（把要计算的填充拷一份出来就可以了），这样可以看到那些不能计算的地方，再用pl线去求那些没有面积的图案
且每个单独的填充图案区域能不能文字标出每个图案面积
以下是那为大侠的编码
(defun c:cs(/ YH_AREA YH_ENT YH_HACOUNT YH_HAREA YH_HNAME YH_INDEX YH_OBJ YH_SLT)
   (vl-load-com)
   (setq YH_slt (ssget '((0 . "HATCH"))))
   (if YH_slt
     (progn
       (setq YH_area '()
      YH_index 0
      )
       (repeat (sslength YH_slt)
  (setq YH_ent (ssname YH_slt YH_index)
        YH_obj (vlax-ename->vla-object YH_ent)
        YH_hname (vla-get-PatternName YH_obj)
        YH_harea (/ (vla-get-area YH_obj) 1000000)
        YH_hacount (assoc YH_hname YH_area)
        )
  (if YH_hacount
    (setq YH_area (subst (cons YH_hname (+ (cdr YH_hacount) YH_harea)) YH_hacount YH_area))
    (setq YH_area (append YH_area (list (cons YH_hname YH_harea))))
    )
  (redraw YH_ent 3)
  (setq YH_index (1+ YH_index))
  )
       (princ (append YH_area (list (cons "总面积" (apply '+ (mapcar 'cdr YH_area))))))
       )
     )
   (princ)
   )


那为大侠有时间优化一下，谢谢

eachy

可以用 vl-catch-all-apply , 但是
(vl-catch-all-apply 'vla-get-area (list hatchobj)) 用在程序内部还是会出现错误信息(auotcad2007）

wjj992

怎么加
我主要是用来计算如很复杂的植物地被面积，现在有了这个程序不同的地被用不同的图案，既然计算各地被面积，有又能计算绿化总面积。很方便
相信各位也能用的上把

eachy

2. 
   
3. (vl-load-com)
   
4. (defun c:cs (/ thisdrawing modelspace cset hname area ll na)
   
5.   (setq        thisdrawing (vla-get-activedocument (vlax-get-acad-object))
   
6.         modelspace  (vla-get-modelspace thisdrawing)
   
7.   )
   
8.   (if (not (vl-catch-all-error-p
   
9.              (setq cset
   
10.                     (vl-catch-all-apply
    
11.                       'vla-item
    
12.                       (list
    
13.                         (vla-get-selectionsets
    
14.                           thisdrawing
    
15.                         )
    
16.                         "CURRENT"
    
17.                       )
    
18.                     )
    
19.              )
    
20.            )
    
21.       )
    
22.     (vla-delete cset)
    
23.   )
    
24.   (if (ssget '((0 . "hatch")))
    
25.     (progn
    
26.       (vlax-for        obj (vla-get-activeselectionset thisdrawing)
    
27.         (setq hname (vla-get-patternname obj)
    
28.               area  (vl-catch-all-apply 'vla-get-area (list obj))
    
29.         )
    
30.         (if (= (type area) 'REAL)
    
31.           (if ll
    
32.             (if        (setq na (assoc hname ll))
    
33.               (setq ll (subst (list hname (+ area (cadr na))) na ll))
    
34.               (setq ll (cons (list hname area) ll))
    
35.             )
    
36.             (setq ll (cons (list hname area) ll))
    
37.           )
    
38.           (progn
    
39.             (vla-put-color obj acred)
    
40.             (vla-highlight obj actrue)
    
41.           )
    
42.         )
    
43.       )
    
44.     )
    
45.   )
    
46.   (princ ll)
    
47.   (princ)
    
48. )

<br /> (vl-load-com)<br /> (defun c:cs (/ thisdrawing modelspace cset hname area ll na)<br />   (setq        thisdrawing (vla-get-activedocument (vlax-get-acad-object))<br />         modelspace  (vla-get-modelspace thisdrawing)<br />   )<br />   (if (not (vl-catch-all-error-p<br />              (setq cset<br />                     (vl-catch-all-apply<br />                       'vla-item<br />                       (list<br />                         (vla-get-selectionsets<br />                           thisdrawing<br />                         )<br />                         "CURRENT"<br />                       )<br />                     )<br />              )<br />            )<br />       )<br />     (vla-delete cset)<br />   )<br />   (if (ssget '((0 . "hatch")))<br />     (progn<br />       (vlax-for        obj (vla-get-activeselectionset thisdrawing)<br />         (setq hname (vla-get-patternname obj)<br />               area  (vl-catch-all-apply 'vla-get-area (list obj))<br />         )<br />         (if (= (type area) 'REAL)<br />           (if ll<br />             (if        (setq na (assoc hname ll))<br />               (setq ll (subst (list hname (+ area (cadr na))) na ll))<br />               (setq ll (cons (list hname area) ll))<br />             )<br />             (setq ll (cons (list hname area) ll))<br />           )<br />           (progn<br />             (vla-put-color obj acred)<br />             (vla-highlight obj actrue)<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (princ ll)<br />   (princ)<br /> )

wjj992

谢谢你。
你们写的好像不一样哦
现在这个调整可以过滤不能计算的图案，但是那个最重要的调整能不能帮我加上去，就是计算完后删除掉可以计算的图案（把要计算的填充拷一份出来就可以了），如果一个平面有几百个填充，不把可以计算的图案删除掉只过滤的话，计算完后几百个图案还在那，就找不出那些可以计算，那些不能计算。另外能不能把单位调整回米做单位，一般大家还是用cad默认值画图，很少改他单位
09年4月现在我才发现你把计算不了的图案过滤变成了红色，你牛，藏的这么深，呵呵。和我想要的效果也差不多，谢谢，谢谢。我还以为没变化呢