悬赏面积统计输出EXCEL

insufficient

tanle2020 发表于 2013-3-31 19:36
大量选取时会漏掉一些，不知道什么原因，希望能修正BUG

正确，大量框选时会漏掉一些；个别区域面积出错，且某些区域程序运行完毕后原封闭线会消失！

九日生

不能，封闭区域多就不行了

九日生

区域一多就出问题了，请调试

su0518

这个怎么运行呀？命令是什么呀

hn10183051

输出在CAD制表统计怎么改呢

snight523

太棒了  

注册

lizhiqiang9801 发表于 2012-2-15 08:42
多谢 辛苦了 能把线形长度也加上吗

(defun c:mjsc (/ d ent f i lst m2 obj pt ss txt x y)
        (setq TextHeight (getdist "\n输入标注文字高度:")
                Textbh (getstring "\n输入编号前缀:"))
  (defun maketext (txt pt)             ; 生成文字子函数
    (entmake (list '(0 . "TEXT") (cons 62 1) (cons 10 pt) (cons 40 TextHeight) (cons 1 txt) '(41 . 0.8)))
  )
  (setvar "cmdecho" 0)
  (vl-load-com)
  (setq ss (ssget) ent (entlast))
  (command ".region" ss "")
  (setq ss (ssadd)  lst nil)
  (while (setq ent (entnext ent))
    (if (= (cdr (assoc 0 (entget ent))) "REGION")
      (setq obj (vlax-ename->vla-object ent) pt (vlax-safearray->list (vlax-variant-value (vla-get-centroid obj)))
                                m2 (rtos (/ (vla-get-area obj) 1000000.0) 2 3)  d (rtos (/ (vla-get-perimeter obj) 1000.0) 2 3)  lst (cons (list pt m2 d) lst)
      )
    )
  )
  (command ".undo" "")
  (setq lst (vl-sort lst (function (lambda (x y)(< (car (car x)) (car (car y)))))))
  (setq lst (vl-sort lst (function (lambda (x y)(> (cadr (car x)) (cadr (car y)))))))
  (setq f (getfiled "指定输出文件路径" "" "xls" 1) f (open f "a"))
  (write-line "编号\t周长(m)\t面积(m2)" f)
  (setq i 1)
  (foreach x lst
    (setq pt (car x) m2 (cadr x) d (caddr x))
    (maketext (strcat Textbh (itoa i)) (list (car pt) (+ (cadr pt) (* 1.2 TextHeight))))
    (maketext (strcat "L=" d "m") pt)
    (maketext (strcat "S=" m2 "m2") (list (car pt) (- (cadr pt) (* 1.2 TextHeight))))
    (write-line (strcat (strcat Textbh (itoa i)) "\t" d "\t" m2) f)
    (setq i (1+ i))
  )
  (close f)
  (princ)
)

白色微風1991

不錯不錯不錯不錯不錯不錯

cad_fans

注册 发表于 2019-8-31 10:59
(defun c:mjsc (/ d ent f i lst m2 obj pt ss txt x y)
        (setq TextHeight (getdist "\n输入标注文字高 ...

学习了

白色微風1991

謝謝熱心人分享源碼