http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 来自 NB闪闪的拿拿斯1988 的新浪微博 转发微博
http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 来自 coolgirl奈津生 的新浪微博
(defun c:tt ()
(setq fn (if (= (type fn) 'STR) fn ""))
(setq fn (getfiled "输出文件名" fn "txt" 4))
(if (setq ss (ssget '((0 . "CIRCLE") (40 . 5.0)))) (progn
(setq i -1)
(setq fp (open fn "w"))
(repeat (sslength ss)
(setq pc (cdr(assoc 10 (entget(ssname ss (setq i (1+ 1))))))
p1 (mapcar '+ pc (list 5 5))
p2 (mapcar '- pc (list 5 5)))
(if (= (sslength(setq ss1 (ssget "C" p1 p2 '((0 . "TEXT"))))) 2) (progn
(setq ent1 (entget(ssname ss1 0)) ent2 (entget(ssname ss1 1))
pt1 (cdr(assoc 10 ent1)) pt2 (cdr(assoc 10 ent2)))
(if (> (cadr pt1) (cadr pt2))
(princ (strcat(cdr(assoc1 1 ent1)) (cdr(assoc 1 ent2))) fp)
(princ (strcat(cdr(assoc1 1 ent2)) (cdr(assoc 1 ent1))) fp)
)
))
)
(close fp)
))
(princ)
)
[/post Z版好程序，今天才看到！ Z版好程序,好久出手一回，学习中 版主的程序略做改造，也可以输出到word (defun wbdc_defun ()
(defun wbdc_set (se) ;将文本实体选择集转换为含实体名的表
(setq l1 (sslength se)
i 0
set0 nil
)
(repeat l1
(setq e0 (ssname se i)
set0 (cons e0 set0)
i (1+ i)
)
)
)
(defun wbdc_sorten (se axis) ;实体按x、y排序
(setq ss nil
sexy (mapcar
'(lambda (x)
(axis (trans (cdr (assoc 10 (entget x))) 0 1))
)
se
)
)
(repeat (length se)
(setq mc (apply 'max sexy)
ii 0
i -1
list1 nil
list0 nil
)
(while (= ii 0)
(setq i (1+ i)
sei (nth i se)
xy(axis (trans (cdr (assoc 10 (entget sei))) 0 1))
)
(if (= mc xy)
(setq ss (cons sei ss)
ii 1
)
(setq list1 (cons (nth i sexy) list1)
list0 (cons sei list0)
)
)
)
(setq sexy (append (reverse list1) (cdr (member mc sexy)))
se (append (reverse list0) (cdr (member sei se)))
)
)
(setq ss (reverse ss))
)
(defun wbdc_row () ;将实体分行
(wbdc_sorten set0 cadr)
(setq row1
set1 (cons (cons (car ss) row) nil)
)
(mapcar
'(lambda (x)
(if (< (+ (cadr (trans (cdr (assoc 10 (entget x))) 0 1))
(cdr (assoc 40 (entget x)))
)
(cadr (trans (cdr (assoc 10 (entget (caar set1)))) 0 1))
)
(setq row (1+ row))
)
(setq set1 (cons (cons x row) set1))
)
(cdr ss)
)
(setq set1 (reverse set1))
)
(defun wbdc_col () ;将实体分列
(setq ss (reverse (wbdc_sorten set0 car)))
(setq col1
set2 (cons (cons (car ss) col) nil)
)
(mapcar
'(lambda (x)
(setq ym nil)
(mapcar
'(lambda (y)
(if (= (cdr y) col)
(setq tmp (entget (car y))
ym(cons
(+ (car (trans (cdr (assoc 10 tmp)) 0 1))
(caadr (textbox tmp))
)
ym
)
)
)
)
set2
)
(if (> (car (trans (cdr (assoc 10 (entget x))) 0 1))
(apply 'max ym)
)
(setq col (1+ col))
)
(setq set2 (cons (cons x col) set2))
)
(cdr ss)
)
(setq set2 (reverse set2))
)
(defun wbdc_main ()
(while (not fn)
(setq fn (getfiled "文本文件" "CADwrod" "doc" 13))
)
(if (findfile fn)
(progn
(initget "Add wbdcite")
(setq fs (getkword "\n覆盖W/<附加A>: "))
(if (= fs "wbdcite")
(setq fs (open fn "w"))
(setq fs (open fn "a"))
)
)
(setq fs (open fn "a"))
)
(initget "Normal Tab")
(setq wmode (getkword "\n制表模式T/<普通文本N>: "))
(if (= wmode nil)
(setq wmode "Normal")
)
(wbdc_set se1)
(wbdc_row)
(wbdc_col)
(setq ij 0)
(repeat row
(setq l1 nil
ij (1+ ij)
)
(mapcar
'(lambda (x)
(if (= (cdr x) ij)
(setq l1 (cons (car x) l1))
)
)
set1
)
(setq l1 (reverse (wbdc_sorten l1 car))
j1 1
)
(mapcar
'(lambda (x)
(setq j2 (cdr (assoc x set2)))
(if (= wmode "Tab")
(progn
(repeat (- j2 j1)
(princ "\t" fs)
)
(princ (cdr (assoc 1 (entget x))) fs)
)
(progn
(repeat (- j2 j1 1)
(princ " " fs)
)
(princ (cdr (assoc 1 (entget x))) fs)
)
)
(setq j1 j2)
)
l1
)
(princ "\n" fs)
)
(close fs)
)
)
(defun c:wbdc (/ axis col e0 fn fs i ii
ij j1 j2 l1 list0 list1 mc olderr
oldsnpoldzinrow se set0 set1 set2 ss
text_name tmp wmode x y ym wbdc_col
wbdc_main wbdc_m_pt wbdc_rowwbdc_sorten wbdc_setna
)
(command "color" (getvar "cecolor"))
(princ "\n选取文本: ")
(setq se1 (ssget '((0 . "TEXT"))))
(if se1
(progn
(wbdc_defun)
(wbdc_main)
)
(princ "\n空选择集。")
)
(princ)
)
(princ "\n**Text文本写入文件，ljs5178@126.com**")
(princ "\n**命令：wbdc")
学习一下！ 香田里浪人 发表于 2013-7-29 08:43
(defun wbdc_defun ()
(defun wbdc_set (se) ;将文本实体选择集转换为含实体名的表
(setq l1 ( ...
感谢大佬分享，学习了
页:
1
[2]