点选标注，显示计算过程并列出文本

zhongzilei

;;; 面积运算  by:langjs
(defun c:aa (/ m2 name obj pt pt1 pt2 ss textH)
     (setq textH (getreal "\n输入新的文字高度<400>:"))
    (setq textH (if (= textH nil)
                400
                textH
              )
  )
  (setq ss (ssadd))
  (setq pt1 (getpoint "\n按顺序选择封闭区域顶点："))
  (while (setq pt2 (getpoint pt1 "\n按顺序选择封闭区域顶点："))
    (entmake (list '(0 . "LWPOLYLINE")
     '(100 . "AcDbEntity")
     '(100 . "AcDbPolyline")
     '(62 . 1)
     (cons 90 2)
     (cons 10 pt1)
     (cons 10 pt2)
      )
    )
    (setq ss  (ssadd (entlast) ss)
   pt1 pt2
    )
  )
  
  (command ".region" ss "")
  (setq obj (vlax-ename->vla-object (setq name (entlast))))
  (if (= (cdr (assoc 0 (entget name))) "REGION")
    (progn
      (setq pt (vlax-safearray->list
   (vlax-variant-value (vla-get-centroid obj))
        )
     m2 (strcat "S=" (rtos (/(vla-get-area obj) 1000000.0) 2 2) "平方米")
      )
      (entmake (list '(0 . "TEXT")
       (cons 62 3)
       (cons 10 pt)
       (cons 40 textH)
       (cons 1 m2)
       '(41 . 0.8)
       '(72 . 1)
       (cons 11 pt)
       '(73 . 0)
        )
      )
      (entdel name)
    )
  )
  (command "erase" ss "")
  (princ)
)

从论坛里资料，学着改了一下，感觉面积加改成平方米能用了

gwpgc

面积计算很好，谢谢zhongzilei 兄，要是还能框选就ok了

aaxxgg

正需要这方面的

YE1044209657

非常好用！谢谢！

vladimirputin

非常好的代码， 谢谢分享啊。

不语勿语

这个编的真的太好了,不知道能不能把标注改成文本数字计算出表达方式呢
;;尺寸运算  by:langjs
(defun c:qq ( / fuh i num obj ss str str1 tt)
  (setq ss (ssget '((0 . "DIMENSION"))))
  (setq fuh "+")
  (while (not (member (setq tt (getstring (strcat "\n请输入运算符号[加(+)/乘(*)] <" fuh ">:")))'("*" "+" ""))))
  (if (/= tt "") (setq fuh tt))
  (if (= fuh "+")(setq num 0) (setq num 1))
  (setq str ""        i 0 )
  (repeat (sslength ss)
    (setq obj (vlax-ename->vla-object (ssname ss i))
          str1 (vla-get-measurement obj)
          i (1+ i)
    )
    (if (= fuh "+")
      (setq num (+ num str1)
            str (strcat str (if (= i 1) "" "+") (rtos str1 2 3))
      )
      (setq num (* num str1)
            str (strcat str (if (= i 1) "" "*") (rtos str1 2 3))
      )
    )
  )
  (entmake (list '(0 . "TEXT") (cons 1 (strcat str "=" (rtos num 2 3))) (cons 10 (getpoint "选择插入点"))
                  (cons 40 (*  (vla-get-textheight obj)(vla-get-scalefactor obj)))
           )
  )
  (princ)
)

664571221

langjs 发表于 2012-11-7 13:03
;;尺寸运算  by:langjs
(defun c:qq ( / fuh i num obj ss str str1 tt)
  (setq ss (ssget '((0 . "DIME ...

你好能不能改成以m为单位