求高手指点修改源码
原帖见此http://bbs.mjtd.com/thread-95135-4-1.html
如何改成房间名字自动拾取而不是单纯的A1A2序列
(defun c:qq (/ 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) 2 2) d (rtos (vla-get-perimeter obj) 2 2) 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周长(mm)\t面积(mm2)" 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 "mm") pt)
(maketext (strcat "S=" m2 "mm2") (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)
)
http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 lucksony的微博 都是高手呀。来了这么多年的CAD ，居然看不懂这是啥。 上去上去@langjs @hao3ren 修改什么？？？ lxw320 发表于 2016-4-8 13:21 static/image/common/back.gif
修改什么？？？
修改可以拾取房间名字到EXCEL而不再只是单纯的 A1要变成对应的房间名字。。
编号 周长(mm) 面积(mm2)
A1 23200 32784375
A2 14500 13078125
A3 11548.75 8020965.41
A4 66300 59349374.04
A5 17750 16226777.1
A6 25000 33999992.37
A7 26850 44313737
A8 61746.4 84060628.65
A9 41600 32199986.88
A10 14200 12400000
A11 17550 17325000
A12 12950 9900000
顶上去顶上去顶上去
页:
[1]