teknomatika 发表于 2022-7-5 17:03:56

实时矩形区域

你好
有没有人知道一个例程,可以在连续绘制时实时提供矩形面积的总和?

tzframpton 发表于 2022-7-5 17:10:09

您可以为此使用数据提取。它提供了实时更新(当然,您必须手动更新表),但它将采用每个矩形,显示每个矩形的面积,并且您可以添加一个页脚来汇总所有值。
 
我已经测试过了,效果很好:

BIGAL 发表于 2022-7-5 17:20:16

我喜欢数据提取的想法。
 
面积总和,您可以通过lisp调用rectang、pline或circle命令,只需记住在绘制对象后添加显示的面积。或在当前区域的任何时间。类似于询问每次运行哪个C-P-R-T。Teknomatica如果你真的想问这个问题。
 
; needs front end what to draw c - p - r - T
; this is generic code may not work on some objects
(if (=obarea nil)(setq obarea 0.0))
(setq obj (vlax-ename->vla-object (entlast)))
(setq obarea (+ (vla-get-area obj) obarea))
(Alert (strcat "Total Area is " (rtos obarea 2 3)))

teknomatika 发表于 2022-7-5 17:21:10

我用李·麦克的这个套路,太棒了。
它解决了我的需求。
但该金额应按顺序实时提供
对三角板的设计。
对不起,翻译的英文。
;;---------------------=={ Total Area }==---------------------;;
;;                                                            ;;
;;Displays the total area of selected objects at the      ;;
;;command line.                                             ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;

(defun c:tArea nil
;; © Lee Mac 2010

(
   (lambda ( SelSet Total i / entity )
   (if SelSet
       (princ
         (strcat "\nTotal Area: "
         (rtos
             (while (setq entity (ssname SelSet (setq i (1+ i))))
               (setq Total
               (+ (vlax-curve-getArea entity) Total)
               )
             )
         )
         )
       )
   )
   )
   (ssget
   (list (cons 0 "CIRCLE,ELLIPSE,*POLYLINE,SPLINE")
       (cons -4 "<NOT")
         (cons -4 "<AND")
         (cons 0 "POLYLINE")
         (cons -4 "<OR")
             (cons -4 "&=") (cons 70 16)
             (cons -4 "&=") (cons 70 64)
         (cons -4 "OR>")
         (cons -4 "AND>")
       (cons -4 "NOT>")
   )
   )
   0.0 -1
)

(princ)
)

teknomatika 发表于 2022-7-5 17:27:30

茨弗兰普顿,
谢谢合作。这是一种可能性,但我想要的似乎不是最实际的解决方案。

BIGAL 发表于 2022-7-5 17:31:56

问题是为什么你在画图的时候需要知道面积?我提出的建议是一个可能的答案,绘制一些东西,添加面积和显示,仔细想想,我会绘制一些东西,然后使用预加载的lisp为总面积绘制“TOTA”。它还可以写入类似于dataextract的文件,例如“圆形区域”。独立命令的优点是,您只能在创建时添加正确的对象。有一个反应堆是可行的,你启动它,它会不断增加面积,直到你停止它。

tzframpton 发表于 2022-7-5 17:40:11

如果您只需要选择一个矩形并查看该区域,则可以在“属性”中执行此操作。不需要李的代码。

teknomatika 发表于 2022-7-5 17:42:52

 
我不明白我的意思。我想连续画许多矩形,同时我想知道各个面积之和的值。也就是说​​每个新矩形都会添加到上一个区域,以此类推。

Lee Mac 发表于 2022-7-5 17:48:00

 
也许是这样?

(defun c:recarea ( / are fun ocs pt1 pt2 tot )
   (setq ocs (trans '(0 0 1) 1 0 t)
         fun (if (zerop (getvar 'worlducs)) getpoint getcorner)
         tot 0.0
   )
   (while
       (and
         (setq pt1 (getpoint "\nSpecify first point <exit>: "))
         (setq pt2 (fun pt1 "\rSpecify opposite corner <exit>: "))
       )
       (entmake
         (list
            '(000 . "LWPOLYLINE")
            '(100 . "AcDbEntity")
            '(100 . "AcDbPolyline")
            '(090 . 4)
            '(070 . 1)
               (cons 038 (caddr (trans pt1 1 ocs)))
               (cons 010 (trans pt1 1 ocs))
               (cons 010 (trans (list (car pt2) (cadr pt1)) 1 ocs))
               (cons 010 (trans pt2 1 ocs))
               (cons 010 (trans (list (car pt1) (cadr pt2)) 1 ocs))
               (cons 210 ocs)
         )
       )
       (setq are (apply '* (mapcar 'abs (mapcar '- pt1 pt2 '(0 0))))
             tot (+ tot are)
       )
       (princ (strcat "\nArea: " (rtos are) " | Total: " (rtos tot)))
   )
   (princ)
)

Grrr 发表于 2022-7-5 17:55:12

我考虑的是面积场对象,它将包括每个新绘制的矩形,因此即使矩形被修改,它也可以工作。
或者某种反应堆。
页: [1] 2
查看完整版本: 实时矩形区域