求助大神，批量生成了填充后如何获得面积。

15019720309

我写了个批量的多段线向两侧偏移，两头接上并填充。代码在下面。请问如何获取这些填充的面积。（重叠部分只算一次）

15019720309

(defun c:sx (/ getds ss i e obj e1 e2 e3 e4 e5 p1 p2 p3 p4 vertex_data vertex_coords e5_data)
  (vl-load-com)
  (setvar "osmode" 0)
  (setvar 'cmdecho 0)
  (initget 2)
  (setq getds (getdist "\n输入偏移距离<可直接量取>:"))
  (setq ss (ssget '((0 . "Arc,Circle,Ellipse,*Line"))))
  (setq i 0)
  (setq long 0)


  ; 遍历全部多段线
  (repeat (sslength ss)
    (setq e   (ssname ss i)
          obj (vlax-ename->vla-object e)
          i   (1+ i)
    )
    ; 左侧偏移
    (vl-catch-all-apply 'vla-offset (list obj getds))
    (setq e1 (entlast))
    (setq e1_data (entget e1))
    (setq vertex_data (vl-remove-if '(lambda (X) (/= 10 (car x))) e1_data))
    (setq vertex_coords (mapcar 'cdr vertex_data))
    (setq p1 (nth 0 vertex_coords))
    (setq p2 (nth (- (length vertex_coords) 1) vertex_coords))

  ; 右侧偏移
    (vl-catch-all-apply 'vla-offset (list obj (* getds -1)))
    (setq e2 (entlast))
    (setq e2_data (entget e2))
    (setq vertex_data (vl-remove-if '(lambda (X) (/= 10 (car x))) e2_data))
    (setq vertex_coords (mapcar 'cdr vertex_data))
    (setq p3 (nth 0 vertex_coords))
    (setq p4 (nth (- (length vertex_coords) 1) vertex_coords))

   
    ; 两头接上，合并
    (command "pline" p1 p3 "")
    (setq e3 (entlast))
    (command "pline" p2 p4 "")
    (setq e4 (entlast))
    (command "join" e1 e2 e3 e4 "")
    (setq e5 (entlast))
    (setq e5_data (entget e5))

    ; 填充
    (setq e5_data (subst (cons 8 "偏移后") (assoc 8 e5_data) e5_data))
    (command "-layer" "c" 5 "偏移后" "")
    (entmod e5_data)
    (setq e5 (entlast))
    (command "-hatch" "p" "ANSI32" "" "" "CO" 5 "" "s" e5 "" "")

  )

  (princ)
)

liuhe

(setq e5 (entlast))
(princ (vla-get-Area (vlax-ename->vla-object  e5)))

15019720309

liuhe 发表于 2024-4-24 12:52
(setq e5 (entlast))
(princ (vla-get-Area (vlax-ename->vla-object  e5)))

你好，我是想获得填充的累计面积，这样一个个加起来应该会把重叠部分加两遍

xyp1964

1. (defun c:tt ()
   
2.   (setvar 'osmode 0)
   
3.   (setvar 'cmdecho 0)
   
4.   (setq dd (Udist 7 "" "偏移距离<输入或鼠标直接量取>" dd nil))
   
5.   (if (setq ss (ssget '((0 . "Arc,Circle,Ellipse,*Line"))))
   
6.     (progn
   
7.       (setq i  0
   
8.             aa 0
   
9.       )
   
10.       (xyp-MkLaCo "偏移后" 6)
    
11.       (repeat (sslength ss)
    
12.         (setq e          (ssname ss i)
    
13.               obj (vlax-ename->vla-object e)
    
14.               i          (1+ i)
    
15.         )
    
16.         (vl-catch-all-apply 'vla-offset (list obj dd)) ; 左侧偏移
    
17.         (setq e1 (entlast))
    
18.         (setq p1 (vlax-curve-getStartPoint e1))
    
19.         (setq p2 (vlax-curve-getEndPoint e1))
    
20.         (vl-catch-all-apply 'vla-offset (list obj (* dd -1))) ; 右侧偏移
    
21.         (setq e2 (entlast))
    
22.         (setq p3 (vlax-curve-getStartPoint e2))
    
23.         (setq p4 (vlax-curve-getEndPoint e2))
    
24.         (command "line" p1 p3 "")
    
25.         (setq e3 (entlast))
    
26.         (command "line" p2 p4 "")
    
27.         (setq e4 (entlast))
    
28.         (command "-hatch" "p" "ANSI32" "" "" "s" e1 e2 e3 e4 "" "")
    
29.         (xyp-SubUpd (list e1 e2 e3 e4) '(8 62) '("偏移后" 6))
    
30.         (setq ob (vlax-ename->vla-object (entlast))
    
31.               aa (+ aa (* (vla-get-area ob) 1e-6))
    
32.         )
    
33.       )
    
34.       (princ "\n面积 = ")
    
35.       (princ aa)
    
36.     )
    
37.   )
    
38.   (princ)
    
39. )

(defun c:tt ()<br />   (setvar 'osmode 0)<br />   (setvar 'cmdecho 0)<br />   (setq dd (Udist 7 "" "偏移距离<输入或鼠标直接量取>" dd nil))<br />   (if (setq ss (ssget '((0 . "Arc,Circle,Ellipse,*Line"))))<br />     (progn<br />       (setq i  0<br />             aa 0<br />       )<br />       (xyp-MkLaCo "偏移后" 6)<br />       (repeat (sslength ss)<br />         (setq e          (ssname ss i)<br />               obj (vlax-ename->vla-object e)<br />               i          (1+ i)<br />         )<br />         (vl-catch-all-apply 'vla-offset (list obj dd)) ; 左侧偏移<br />         (setq e1 (entlast))<br />         (setq p1 (vlax-curve-getStartPoint e1))<br />         (setq p2 (vlax-curve-getEndPoint e1))<br />         (vl-catch-all-apply 'vla-offset (list obj (* dd -1))) ; 右侧偏移<br />         (setq e2 (entlast))<br />         (setq p3 (vlax-curve-getStartPoint e2))<br />         (setq p4 (vlax-curve-getEndPoint e2))<br />         (command "line" p1 p3 "")<br />         (setq e3 (entlast))<br />         (command "line" p2 p4 "")<br />         (setq e4 (entlast))<br />         (command "-hatch" "p" "ANSI32" "" "" "s" e1 e2 e3 e4 "" "")<br />         (xyp-SubUpd (list e1 e2 e3 e4) '(8 62) '("偏移后" 6))<br />         (setq ob (vlax-ename->vla-object (entlast))<br />               aa (+ aa (* (vla-get-area ob) 1e-6))<br />         )<br />       )<br />       (princ "\n面积 = ")<br />       (princ aa)<br />     )<br />   )<br />   (princ)<br /> )

15019720309

xyp1964 发表于 2024-4-24 19:09

你好，是要导入什么第三方库吗？no function definition: XYP-MKLACO