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" "POLYLINE""REGION""LOFTEDSURFACE""SURFACE""REVOLVEDSURFACE ...

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

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

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

那确实，只是告诉他有这么个方法
页: [1] 2
查看完整版本: 面积求和