正在寻找可以计算的Lsp

Kumbra · 发表于 2022-7-5 16:48:03

首先，大家好！很高兴成为其中一员。
我对这个论坛很陌生，所以对于AutoCad软件，我是一个地理信息系统狂热者。

目前正在进行一些城市规划，我的公司需要计算现有多边形、图案填充和多段线的面积。很多人在同一个项目上工作，这就是为什么我们有不同类型的几何体。
我可以手动将所有这些更改为闭合多段线，但有2000多个多边形和图案填充。
是否有任何lsp可以计算所有类型的几何体？我尝试了很多，但他们只是在计算闭合多段线。

非常感谢，很抱歉英语不好

Lee Mac · 发表于 2022-7-5 17:02:22

该程序不需要闭合多段线：总面积

BIGAL · 发表于 2022-7-5 17:11:37

我现在正在做的事情

copy


; Total HATCH area labeller
(Defun C:AHAT (/ arean area2 lay col en hobj Hp num rp sset)
(setq Hp (ENTGET (CAR (ENTSEL "\nPICK HATCH "))))
(SETQ LAY (CDR (ASSOC 8 HP)))
(setq sset (ssget  (list (cons 0 "hatch") (CONS 8 LAY))))
(setq arean 0)
(setq area2 0)
(REPEAT (setq num (sslength sset))
(setq en (ssname sset (setq num (- num 1))))
(SETQ COL (CDR (ASSOC 62 (entget EN)))) ; by layer check
(SETQ ARNEW (vla-get-area (vlax-ename->vla-object en)))
(IF (= COL NIL) 
(setq AREAN (+ AREAN ARNEW))
(SETQ AREA2 (+ AREA2 ARNEW))
)
)
(ALERT (STRCAT "AREA IS ..." (RTOS AREAN 2 2)"\N\NAREA2 IS ..." (RTOS AREA2 2 2)))
(princ)
)

Grrr · 发表于 2022-7-5 17:22:13

比加尔，是你激励我写这篇文章的：

copy


; Total area of hatches with certain pattern
(defun C:test ( / SH enx SS i Lst )
 (setvar 'errno 0)
 (while (/= 52 (getvar 'errno))
   (setq SH (car (entsel "\nSelect source hatch pattern to filter by <exit>: ")))
   (cond
     ((= 7 (getvar 'errno)) (princ) (setvar 'errno 0))
     ((and SH (/= "HATCH" (cdr (assoc 0 (setq enx (entget SH))))) (princ "\nThis is not a "HATCH".")))
     (
       (and
         SH
         (princ (strcat "\nSelect hatches with "" (cdr (assoc 2 enx)) "" pattern to sum their area: "))
         (setq SS (ssget (list (assoc 0 enx) (assoc 2 enx))))
         (repeat (setq i (sslength SS))
           (setq Lst (cons (vla-get-Area (vlax-ename->vla-object (ssname SS (setq i (1- i))))) Lst))
         )
         (not (alert (strcat "\nTotal area of the hatch with "" (cdr (assoc 2 enx)) "" pattern is: " (rtos (apply '+ Lst) 2 2) " units.")))
       )
       (setvar 'errno 52)
     )
   )
 )
 (princ)
)