消失的天空
发表于 2019-5-1 18:32:56
楼主下载文件哪儿有,没看到呢。
1291500406
发表于 2019-5-1 18:37:43
消失的天空 发表于 2019-5-1 18:32
楼主下载文件哪儿有,没看到呢。
(defun c:bb ( /hangdau)(defun sosanh (e1 e2 / p1 p2)(setq p1 (car e1)p2 (car e2))
(if (equal (cadr p1) (cadr p2) fuzz)(< (car p1) (car p2))(< (cadr p2) (cadr p1))))
(setq ss (ssget '((0 . "TEXT"))) lst (ss2ent ss) lst (mapcar '(lambda (e) (cons (cdr (assoc 10 (entget e))) (cdr (assoc 1 (entget e))))) lst)
lst (mapcar '(lambda (e) (if (= (cdr e) "*") (cons (car e) "") e)) lst) caotext (cdr (assoc 40 (entget (ssname ss 0))))
fuzz (* caotext 1.0) lst (vl-sort lst 'sosanh) index 1 oldy nil
fid (open "d:\\xls数据文件.csv""w"))
(command "start" "d:\\xls数据文件.csv")
(foreach e lst(if (equal oldy (cadr (car e)) fuzz)(progn(princ "," fid)(setq index (1+ index)))
(progn(if hangdau(progn(setq index 1)(princ "\n" fid))(setq hangdau t))))
(princ (cdr e) fid)(setq oldy (cadr (car e))))(close fid))
(defun ss2ent (ss / sodt index lstent)(setq sodt (if ss(sslength ss)0)index 0)
(repeat sodt(setq ent (ssname ss index)index (1+ index)lstent (cons ent lstent)))(reverse lstent))
消失的天空
发表于 2019-5-3 22:18:46
http://bbs.mjtd.com/thread-93510-1-1.html,导出速度慢一些。楼主这个速度快,不足就是空格子没文字会被后面的列填上去。
langke52
发表于 2019-5-19 11:57:58
谢谢楼主分享。
1028695446
发表于 2019-6-26 22:57:33
;;在原本的基础上优化了了,打开文件故障的问题
(defun c:c2e (/ hangdau @dclfiledame)
(defun sosanh (e1 e2 / p1 p2)
(setq p1 (car e1)
p2 (car e2)
)
(if (equal (cadr p1) (cadr p2) fuzz)
(< (car p1) (car p2))
(< (cadr p2) (cadr p1))
)
)
(setq ss (ssget '((0 . "TEXT")))
lst (ss2ent ss)
lst (mapcar '(lambda (e)
(cons (cdr (assoc 10 (entget e)))
(cdr (assoc 1 (entget e)))
)
)
lst
)
lst (mapcar '(lambda (e)
(if (= (cdr e) "*")
(cons (car e) "")
e
)
)
lst
)
caotext (cdr (assoc 40 (entget (ssname ss 0))))
fuzz (* caotext 1.0)
lst (vl-sort lst 'sosanh)
index 1
oldy nil
@dclfiledame (vl-filename-mktemp nil nil ".csv")
fid (open @dclfiledame "w")
)
(vlax-invoke
(vlax-get-or-create-object "Wscript.Shell")
'RUN
@dclfiledame ;;(任意已经建立关联程序的文件)
)
(foreach e lst
(if (equal oldy (cadr (car e)) fuzz)
(progn (princ "," fid) (setq index (1+ index)))
(progn (if hangdau
(progn (setq index 1) (princ "\n" fid))
(setq hangdau t)
)
)
)
(princ (cdr e) fid)
(setq oldy (cadr (car e)))
)
(close fid)
)
(defun ss2ent (ss / sodt index lstent)
(setq sodt(if ss
(sslength ss)
0
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent)
)
1028695446
发表于 2019-6-26 22:59:09
打开文件的帖子
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=109775&highlight=%B4%F2%BF%AA%CE%C4%BC%FE
pcxg
发表于 2019-10-10 13:27:25
用什么命令啊?
happy336
发表于 2019-10-14 22:32:05
谢谢分享,支持
sunny_8848
发表于 2019-10-15 08:10:46
谢谢楼主分享,学习中
面条渣渣2
发表于 2019-12-22 17:54:52
谢谢大神分享!!!!!!!!!!!!!!