实时选择信息
工作中经常遇到查看图元长度及面积选项不知道这个图片中实时选择信息是怎么实现的，哪位有这样的程序是否能分享一下自己编个累积显示面积，周长的代码，同时亮显选择集即可，这种代码论坛有的 aa命令就可以测量单个的周长和面积 要有lisp基础才能自己动手。
我的程序，这个要用到反应器的 雨的节奏 发表于 2022-5-18 23:33
我的程序，这个要用到反应器的
大神是否可以发个 ;;;用法：先在程序命令行中输入此句：;
;;;(setenv "AutoAreaReader" "1")
;;;再加载本程序，注意，需要这样的步骤才能起作用;
;;;然后，每次点击（单击）封闭多义线，就会在命令行中得到选取多义线的面积，;
;;;一次选择多个封闭多义线的话，会得到面积总和。;
;;;如果发现给出的面积是英制的话，输入如下语句：(setq def_show_area "Decimal")
;; by LE
;; 要启用或禁用此功能，请使用：
;; For ON:
;; (setenv "AutoAreaReader" "1")
;; For OFF:
;; (setenv "AutoAreaReader" "0")
;;
;;
;; 要更改打印输出，请使用：
;; Variable name: def_show_area
;; Options:
;; 1. "Decimal"十进制
;; 2. "Squarefeet"平方英尺
;; 3. "Acres"英亩
;; 4. "SquareMeters"平方米
;; 5. "Hectares"公顷
;; In example:
;; Command: (setq def_show_area "Acres")
;; Command: (setq def_show_area "Decimal")
;;--------------------------------------------------------------
(if (not (getenv "AutoAreaReader")) (setenv "AutoAreaReader" "1"))
;;--------------------------------------------------------------
(defun dtt-ssget->vla-list(ss / index vlaList)
(setq index (if ss (1- (ssLength ss)) -1))
(while (>= index 0)
(setq
vlaList (cons (vlax-ename->vla-object (ssname ss index)) vlaList)
index (1- index)
)
)
vlaList
)
;;--------------------------------------------------------------
(defun dtt-addcomma(txt / strl cont1 lth cont txt1)
(setq strl(strlen txt)
cont1 1
txt1"")
(while (and (/= (substr txt cont1 1) ".") (<= cont1 strl))
(setq cont1 (1+ cont1)))
(setq lth (1- cont1)
cont1 1
cont(1- lth))
(if (> lth 3)
(progn
(while (< cont1 lth)
(setq let(substr txt cont1 1)
txt1 (strcat txt1 let))
(if (and (zerop (rem cont 3)) (eq (type (read let)) 'INT))
(setq txt1 (strcat txt1 ",")))
(setq cont(1- cont)
cont1 (1+ cont1)))
(while (<= cont1 strl)
(setq txt1(strcat txt1 (substr txt cont1 1))
cont1 (1+ cont1)))
txt1)
txt))
;;--------------------------------------------------------------
(defun dtt-print-area(ar / string)
(setq string
"\nChange variable LUPREC to a higher precision value - try again.")
(if (not def_show_area)
(setq def_show_area "Decimal"))
(cond
((= def_show_area "Decimal")
(if (zerop (atof (rtos ar 2 (getvar "luprec"))))
(prompt string)
(princ
(dtt-addcomma
(rtos ar 2 (getvar "luprec"))))))
((= def_show_area "Squarefeet")
(if (zerop (atof (rtos (/ ar 144.0) 2 (getvar "luprec"))))
(prompt string)
(progn
(princ
(dtt-addcomma (rtos (/ ar 144.0) 2 (getvar "luprec"))))
(princ " square feet"))))
((= def_show_area "Acres")
(if
(zerop
(atof (rtos (/ (/ ar 144.0) 43560.0) 2 (getvar "luprec"))))
(prompt string)
(progn
(princ
(dtt-addcomma
(rtos (/ (/ ar 144.0) 43560.0) 2 (getvar "luprec"))))
(princ " acres"))))
((= def_show_area "SquareMeters")
(if (zerop (atof (rtos ar 2 (getvar "luprec"))))
(prompt string)
(progn
(princ
(dtt-addcomma
(rtos ar 2 (getvar "luprec"))))
(princ " m2"))))
((= def_show_area "Hectares")
(if
(zerop
(atof (rtos (/ ar 10000.0) 2 (getvar "luprec"))))
(prompt string)
(progn
(princ
(dtt-addcomma
(rtos (/ ar 10000.0) 2 (getvar "luprec"))))
(princ " hectares"))))))
;;--------------------------------------------------------------
(defun areareader-pickfirst
(reactor params / ss ent obj ar pol_data lst_dat)
(if (eq (getenv "AutoAreaReader") "1")
(cond
((and
(eq 1 (logand 1 (getvar "pickfirst")))
(setq ss (ssget "_i" '((0 . "LWPOLYLINE"))))
(eq 1 (sslength ss))
(setq ent (ssname ss 0))
(setq obj (vlax-ename->vla-object ent))
(eq (vla-get-closed obj) :vlax-true)
)
(setq ar (vla-get-area obj))
(princ "\n单个多段线的面积= ")
(dtt-print-area ar)
(princ)
)
((and
(eq 1 (logand 1 (getvar "pickfirst")))
(setq ss (ssget "_i" '((0 . "LWPOLYLINE"))))
(> (sslength ss) 1)
(vl-every
(function (lambda (obj) (eq (vla-get-closed obj) :vlax-true)))
(setq objs (dtt-ssget->vla-list ss))
)
)
(princ "\n多条多段线的总面积= ")
(setq ar (apply '+ (mapcar 'vla-get-area objs)))
(dtt-print-area ar)
(princ)
)
)
)
)
(if (not areareader_pickfirst_reactor)
(setq areareader_pickfirst_reactor
(vlr-set-notification
(vlr-miscellaneous-reactor "AutoAreaReader" '((:vlr-pickfirstmodified . areareader-pickfirst)))
'active-document-only
)
)
)
;;--------------------------------------------------------------
(defun dtt-removeall (reactor params) (vlr-remove-all))
(if (not dtt_reactor_dwg)
(setq dtt_reactor_dwg
(vlr-set-notification
(vlr-editor-reactor "removeallreactors" '((:vlr-beginclose . dtt-removeall)))
'active-document-only
)
)
)
;;--------------------------------------------------------------
(cond
;; ON
((and
(eq (getenv "AutoAreaReader") "1")
areareader_pickfirst_reactor
(not (vlr-added-p areareader_pickfirst_reactor))
)
(vlr-add areareader_pickfirst_reactor)
)
;; OFF
((and
(eq (getenv "AutoAreaReader") "0")
areareader_pickfirst_reactor
(vlr-added-p areareader_pickfirst_reactor)
)
(vlr-remove areareader_pickfirst_reactor)
)
)
(princ)
页:
[1]