insufficient 发表于 2016-4-21 16:25:43

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

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

九日生 发表于 2016-4-22 19:46:19

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

九日生 发表于 2016-4-23 08:37:52

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

su0518 发表于 2016-5-1 22:03:20

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

hn10183051 发表于 2019-8-30 15:01:59


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

snight523 发表于 2019-8-31 10:36:27

太棒了:handshake

注册 发表于 2019-8-31 10:59:36

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 发表于 2022-6-30 17:29:24

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

cad_fans 发表于 2022-9-5 10:01:04

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

学习了:handshake

白色微風1991 发表于 2022-9-6 07:43:04

謝謝熱心人分享源碼
页: 1 2 3 4 5 [6] 7
查看完整版本: 悬赏面积统计输出EXCEL