面积求和

ocoipw · 发表于 2025-1-22 02:07:11

;;计算各种表面、面域的面积和。设计何勇
;;注意：绘图单位以毫米计。
(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)
)

韩飞翔 · 发表于 2025-1-22 09:28:24

;; | 实体面积 |
;; =============================================
;;说明:实体面积
;;参数:ent

car (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
)

ocoipw · 发表于 2025-1-22 19:34:27

yanshengjiang 发表于 2025-1-22 15:03
前辈你好这样看起来在ssget的时候就能过滤

;;你说得有道理，根据你的建议将程序修改如下：

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

;;欢迎各位朋友批评指正

xyp1964 · 发表于 2025-1-22 09:29:55

本帖最后由 xyp1964 于 2025-1-22 23:01 编辑

(defun c:tt ()
(if (setq ss (ssget '((0 . "arc,cir*,*line,re*,*surface,ell*"))))
(progn
(setq i -1
a 0
)
(while (setq e (ssname ss (setq i (1+ i))))
(command "AREA" "o" e)
(setq a (+ a (getvar 'AREA)))
)
(princ (strcat "\n总面积为: " (rtos a) " 平方毫米"))
(princ (strcat "\n总面积为: " (rtos (* a 1e-6)) " 平方米"))
)
)
(princ)
)

自贡黄明儒 · 发表于 2025-1-22 07:57:03

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

yefei812678 · 发表于 2025-1-22 08:24:34

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

夏生生 · 发表于 2025-1-22 09:02:20

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

tanxindong · 发表于 2025-1-22 13:07:19

好代码，学习了，谢谢

你有种再说一遍 · 发表于 2025-1-22 14:29:01

自贡黄明儒发表于 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 15:03:20

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

前辈你好

这样看起来在ssget的时候就能过滤

夏生生 · 发表于 2025-1-22 16:24:30

yanshengjiang 发表于 2025-1-22 15:03
前辈你好这样看起来在ssget的时候就能过滤

那确实，只是告诉他有这么个方法

账号		自动登录	找回密码
密码			注册

[源码] 面积求和