面积求和

ocoipw

;;计算各种表面、面域的面积和。设计 何勇
;;注意：绘图单位以毫米计。
(defun C:calmj(/ ss e ent)
  (setq ss (ssget))
  (setq are1 0)
  (while ss
    (setq
      e (ssname ss 0)
      ent (entget e)
      ss (if (> (sslength ss) 1)
             (ssdel e ss)
          nil
         )
    )
    (cond ((or (=  (cdr (assoc 0 ent))  "LWPOLYLINE")
                           (=  (cdr (assoc 0 ent))  "POLYLINE")
                           (=  (cdr (assoc 0 ent))  "REGION")
                           (=  (cdr (assoc 0 ent))  "LOFTEDSURFACE")
                           (=  (cdr (assoc 0 ent))  "SURFACE")
                           (=  (cdr (assoc 0 ent))  "REVOLVEDSURFACE")
                           (=  (cdr (assoc 0 ent))  "EXTRUDEDSURFACE")
                           (=  (cdr (assoc 0 ent))  "PLANESURFACE")
                           (=  (cdr (assoc 0 ent))  "SWEPTSURFACE")
                   )
                 (command "AREA" "e" e)
                   (setq
                         are1 (+ are1 (getvar "AREA"))
                   )
              )
        );;end cond
  );;end while
  (princ (strcat "\n总面积为:" (rtos are1) "mm2"))
  (princ (strcat "\n总面积为:" (rtos (/ are1 1000000.0)) "m2"))
  (prin1)
)

自贡黄明儒

似乎alisp只能用(command "AREA" "e" e)求面积，autocad2000之后有了com,用vla-get-area就可以求得面积

yefei812678

谢谢分享谢谢分享谢谢分享

夏生生

(member (cdr (assoc 0 ent))'("LWPOLYLINE" "POLYLINE""REGION""LOFTEDSURFACE""SURFACE""REVOLVEDSURFACE""EXTRUDEDSURFACE""PLANESURFACE""SWEPTSURFACE"))

韩飞翔

;;    |                 实体面积                 |
;;    =============================================
;;说明:实体面积
;;参数:entcar (entsel))
;;返回fx-area (car (entsel)))面积
(defun fx-area(ent / obj-vla obj-area)
        (if (and ent (= 'ENAME (type ent)))
                (progn
                        (setq obj-vla (vlax-ename->vla-object ent))
                        (setq obj-area (vla-get-Area obj-vla))
                )
        )
)       
;;    =============================================
;;    |              选择集实体面积               |
;;    =============================================
;;说明:图形面积 m2
;;参数:ss:选择集或图元 (选择集则为面积和)
;;返回fx-txmj (ssget))  (fx-txmj (car (entsel)))
(defun fx-txmj(ss / EN N ssa TOT_AREA)
        (if (and ss (= 'PICKSET (type ss)))
                (setq ss ss)
                (if (and ss (= 'ENAME (type ss)))
                        (progn
                                (setq
                                        ssa nil
                                        ssa (ssadd)
                                        ssa (ssadd ss ssa)
                                        ss ssa
                                )
                        )
                )               
        )
        (if (and ss (= 'PICKSET (type ss)))
                (progn
                        (setq n -1)
                        (setq tot_area 0)      
                        (repeat (sslength ss)
                                (setq en (vla-get-Area (vlax-ename->vla-object (ssname ss (setq n (1+ n))))))
                                (setq tot_area (+ tot_area en))
                        )
                        (setq tot_area (/ tot_area 1000000))
                )
        )
        tot_area
)

xyp1964

1. (defun c:tt ()
   
2.   (if (setq ss (ssget '((0 . "arc,circle,spline,*po*,region,*surface"))))
   
3.     (progn
   
4.       (setq i -1
   
5.             a 0
   
6.       )
   
7.       (while (setq e (ssname ss (setq i (1+ i))))
   
8.         (command "AREA" "o" e)
   
9.         (setq a (+ a (getvar 'AREA)))
   
10.       )
    
11.       (princ (strcat "\n总面积为: " (rtos a) " 平方毫米"))
    
12.       (princ (strcat "\n总面积为: " (rtos (* a 1e-6)) " 平方米"))
    
13.     )
    
14.   )
    
15.   (princ)
    
16. )

(defun c:tt ()<br />   (if (setq ss (ssget '((0 . "arc,circle,spline,*po*,region,*surface"))))<br />     (progn<br />       (setq i -1<br />             a 0<br />       )<br />       (while (setq e (ssname ss (setq i (1+ i))))<br />         (command "AREA" "o" e)<br />         (setq a (+ a (getvar 'AREA)))<br />       )<br />       (princ (strcat "\n总面积为: " (rtos a) " 平方毫米"))<br />       (princ (strcat "\n总面积为: " (rtos (* a 1e-6)) " 平方米"))<br />     )<br />   )<br />   (princ)<br /> )

tanxindong

好代码，学习了，谢谢

你有种再说一遍

自贡黄明儒 发表于 2025-1-22 07:57
似乎alisp只能用(command "AREA" "e" e)求面积，autocad2000之后有了com,用vla-get-area就可以求得面积

https://www.cnblogs.com/JJBox/p/14300098.html#_lab2_4_4
鞋带公式,直接算,嘻嘻

yanshengjiang

夏生生 发表于 2025-1-22 09:02
(member (cdr (assoc 0 ent))'("LWPOLYLINE" "OLYLINE""REGION""LOFTEDSURFACE""SURFACE""REVOLVEDSURFACE ...

前辈你好    这样看起来在ssget的时候就能过滤