实时矩形区域
你好有没有人知道一个例程,可以在连续绘制时实时提供矩形面积的总和? 您可以为此使用数据提取。它提供了实时更新(当然,您必须手动更新表),但它将采用每个矩形,显示每个矩形的面积,并且您可以添加一个页脚来汇总所有值。
我已经测试过了,效果很好:
我喜欢数据提取的想法。
面积总和,您可以通过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)))
我用李·麦克的这个套路,太棒了。
它解决了我的需求。
但该金额应按顺序实时提供
对三角板的设计。
对不起,翻译的英文。
;;---------------------=={ 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)
) 茨弗兰普顿,
谢谢合作。这是一种可能性,但我想要的似乎不是最实际的解决方案。 问题是为什么你在画图的时候需要知道面积?我提出的建议是一个可能的答案,绘制一些东西,添加面积和显示,仔细想想,我会绘制一些东西,然后使用预加载的lisp为总面积绘制“TOTA”。它还可以写入类似于dataextract的文件,例如“圆形区域”。独立命令的优点是,您只能在创建时添加正确的对象。有一个反应堆是可行的,你启动它,它会不断增加面积,直到你停止它。 如果您只需要选择一个矩形并查看该区域,则可以在“属性”中执行此操作。不需要李的代码。
我不明白我的意思。我想连续画许多矩形,同时我想知道各个面积之和的值。也就是说每个新矩形都会添加到上一个区域,以此类推。
也许是这样?
(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)
)
我考虑的是面积场对象,它将包括每个新绘制的矩形,因此即使矩形被修改,它也可以工作。
或者某种反应堆。
页:
[1]
2