（已解决）输出表格无法按正常顺序排列1、2、3、4、5、6、7、8、9、10、11、12、、...
本帖最后由 zfsaaa 于 2013-7-3 12:12 编辑输出表格无法按正常顺序排列1、2、3、4、5、6、7、8、9、10、11、12、、、、的缺陷，请高手修正
;;; 框选封闭区域面积到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)
)
本帖最后由 Gu_xl 于 2013-7-3 11:37 编辑
排序函数这样写：
(setq lst (vl-sort lst '(lambda (a b) (< (atoi (car a)) (atoi (car b)))))) 谢谢，已解决
页:
[1]