悬赏面积统计输出EXCEL
求各位高手帮忙写一个LISP，要求很简单，
就这一个功能
请看图
直接框选，把框选里面的 面域面积统计出来
还有版号也是，
（我说有的图纸，版号都在面域里面的）
本帖最后由 langjs 于 2012-2-14 19:55 编辑
;;; 框选封闭区域面积到excel by:langjs
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
(defun c:qq (/ appxls col ent ent1 f i lst m2 newbook newitem newsheet numrow pt ss txt value xlscells xlsworkbooks)
(defun initexcel ()
(setq appxls (vlax-get-or-create-object "excel.application")
xlsworkbooks (vlax-get-property appxls "workbooks")
newbook (vlax-invoke-method xlsworkbooks "add")
newsheet (vlax-get-property newbook "sheets")
newitem (vlax-get-property newsheet "item" 1)
xlscells (vlax-get-property newitem "cells")
)
(vla-put-visible appxls :vlax-true)
)
(defun endexcel ()
(vlax-release-object xlscells)
(vlax-release-object newitem)
(vlax-release-object newsheet)
(vlax-release-object newbook)
(vlax-release-object xlsworkbooks)
(vlax-release-object appxls)
)
(defun datacell (nurow col value)
(vlax-put-property xlscells "item" numrow col (vl-princ-to-string value))
)
(setvar "cmdecho" 0)
(vl-load-com)
(if (setq ss (ssget '((0 . "*TEXT"))))
(progn
(= lst nil)
(repeat (setq i (sslength ss))
(setq ent (entget (ssname ss (setq i (1- i))))
pt (cdr (assoc 10 ent))
txt (cdr (assoc 1 ent))
)
(command "-boundary" pt "")
(command ".region" (entlast) "")
(setq ent1 (entlast))
(if (= (cdr (assoc 0 (entget ent1))) "REGION")
(setq ent (vlax-ename->vla-object ent1)
m2 (rtos (vla-get-area ent))
lst (cons (list txt m2) lst)
f (entdel ent1)
)
)
)
(setq lst (vl-sort lst (function (lambda (x y)
(< (car x) (car y))
)
)
)
)
(setq lst (cons (list "版号" "面积") lst))
(initexcel)
(setq numrow 1)
(foreach f lst
(datacell numrow 1 (car f))
(datacell numrow 2 (cadr f))
(setq numrow (1+ numrow))
)
(endexcel)
)
)
(princ)
)
没有高手感兴趣吗？ 为什么任兵 发表于 2012-2-13 21:06 static/image/common/back.gif
没有高手感兴趣吗？
好程序 不知道怎么 我统计出输出到exce中个数翻倍再提议一下 能把线长度加上，输出的单位是实际单位，再就是能输出到已打开的exce中吗？ 多谢 谢谢热心人分享源码 本帖最后由 langjs 于 2012-3-2 23:19 编辑
现学现卖
;;; 框选封闭区域面积到excel by:langjs
;;; ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
(defun c:qq (/ appxls col ent ent1 ent2 f i lst lst1 m2 maxpoint minpoint na
newbook newitem newsheet numrow pc pmax pmin pt sc snap ss
txt value vh viewsize vw x xlscells xlsworkbooks y
)
(defun GetViewSize (/ pc vh sc vw vh pmin pmax)
(setq pc (getvar "viewctr")
vh (getvar "viewsize")
sc (getvar "screensize")
vw (* vh (/ (car sc) (cadr sc)))
pmin (list (- (car pc) (* 0.5 vw)) (- (cadr pc) (* 0.5 vh)))
pmax (list (+ (car pc) (* 0.5 vw)) (+ (cadr pc) (* 0.5 vh)))
)
(list pmin pmax)
)
(defun initexcel ()
(setq appxls (vlax-get-or-create-object "excel.application")
xlsworkbooks (vlax-get-property appxls "workbooks")
newbook (vlax-invoke-method xlsworkbooks "add")
newsheet (vlax-get-property newbook "sheets")
newitem (vlax-get-property newsheet "item" 1)
xlscells (vlax-get-property newitem "cells")
)
(vla-put-visible appxls :vlax-true)
)
(defun endexcel ()
(vlax-release-object xlscells)
(vlax-release-object newitem)
(vlax-release-object newsheet)
(vlax-release-object newbook)
(vlax-release-object xlsworkbooks)
(vlax-release-object appxls)
)
(defun datacell (nurow col value)
(vlax-put-property xlscells "item" numrow col
(vl-princ-to-string value)
)
)
(vl-load-com)
(setvar "cmdecho" 0)
(setq snap (getvar "osmode")) ; 关闭捕捉
(setvar "osmode" 0)
(if (setq ss (ssget '((0 . "*TEXT"))))
(progn
(setq ViewSize (GetViewSize))
(setq lst1 '())
(repeat (setq i (sslength ss))
(setq ent (entget (ssname ss (setq i (1- i))))
pt (cdr (assoc 10 ent))
txt (cdr (assoc 1 ent))
)
(command "-boundary" pt "")
(setq ent2 (entlast))
(if (= (cdr (assoc 0 (entget ent2))) "LWPOLYLINE")
(progn
(vla-getboundingbox (vlax-ename->vla-object ent2) 'minpoint
'maxpoint
)
(setq pmax (vlax-safearray->list maxpoint)
pmin (vlax-safearray->list minpoint)
)
(entdel ent2)
(setq lst1 (cons (list pmin pmax pt txt) lst1))
)
)
)
(= lst nil)
(repeat (setq i (length lst1))
(setq na (nth (setq i (1- i))
lst1
)
pmin (car na)
pmax (cadr na)
pt (caddr na)
txt (cadddr na)
)
(command ".zoom" "W" pmin pmax)
(command "-boundary" pt "")
(command ".region" (entlast) "")
(setq ent1 (entlast))
(if (= (cdr (assoc 0 (entget ent1))) "REGION")
(setq ent (vlax-ename->vla-object ent1)
m2 (rtos (vla-get-area ent) 2 2)
lst (cons (list txt m2) lst)
f (entdel ent1)
)
)
)
(command ".zoom" "W" (car ViewSize) (cadr ViewSize))
(setq lst (vl-sort lst (function (lambda (x y)
(< (car x) (car y))
)
)
)
)
(setq lst (cons (list "版号" "面积") lst))
(initexcel)
(setq numrow 1)
(foreach f lst
(datacell numrow 1 (car f))
(datacell numrow 2 (cadr f))
(setq numrow (1+ numrow))
)
(endexcel)
)
)
(setvar "osmode" snap) ; 恢复捕捉
(princ)
)
langjs 发表于 2012-2-14 19:56 static/image/common/back.gif
现学现卖
;;; 框选封闭区域面积到excel by:langjs
多谢 辛苦了 能把线形长度也加上吗 好东西，值得学习！ 二楼犀利啊，顶起 输出excel目的是什么