求助改一下代码，让它能按顺序放

sgyyuan 发表于 2013-3-21 16:27:08

求助：
下列代码可以将文字提取到表格，一个个选没问题，但如果是框选一块，它提取到表格的文字并不按图中文字所在上下顺序放，能不能让它按CAD图中位置顺序放在表格里！

(defun c:Q (/ SS FF I)
(if (and (setq SS (ssget '((0 . "*TEXT"))))
(if (findfile "d:\\ABC.xls")
   (setq FF (open "d:\\ABC.xls" "a"))
   (setq FF (open "d:\\ABC.xls" "w"))
)
   )
(progn (setq I -1)
(repeat (sslength SS)
   (princ (cdr (assoc 1 (entget (ssname ss (setq i (1+ i))))))
   FF
   )
   (princ "\n" FF)
)
(close ff)
)
)
(prin1)
)

ll_j 发表于 2013-3-22 17:15:42

sgyyuan 发表于 2013-3-22 16:09 static/image/common/back.gif
感谢 ll_j，我对LISP是小白，只是应用需要，从坛里找的，挺好用，就差顺序，如果您没时间细弄，能否请您帮我 ...

(defun c:Q (/ SS FF I ent e1 ey sel)
(if (and (setq SS (ssget '((0 . "*TEXT"))))
(if (findfile "d:\\ABC.csv")
   (setq FF (open "d:\\ABC.csv" "a"))
   (setq FF (open "d:\\ABC.csv" "w"))
)
   )
(progn
   (setq I-1
   selnil
   )
   (repeat (sslength SS)
(setq i (1+ i)
   ent (entget (ssname ss i))
   e1(cdr (assoc 1 ent))
   ey(caddr (assoc 10 ent))
   sel (cons (list e1 ey) sel)
)
   )
   (setq sel (vl-sort sel '(lambda (y1 y2) (> (cadr y1) (cadr y2)))))
   (mapcar '(lambda (e)
(princ e FF)
(princ "\n" ff)
      )
   (mapcar 'car sel)
   )
   (close ff)
)
)
(princ)
)

ll_j 发表于 2013-3-21 18:52:39

给你一个思路：
把选择的文本和插入点提取出来，构成一个表，然后把所有这样的表构成一个大的表，在使用vl-sort来根据y值排序，再逐一写入文件中。

另：文本文件不要使用xls扩展名，如果想方便excel打开，可以使用csv后缀。

品茗新秀 发表于 2013-3-21 18:55:12

电子表格内的数据一般用什么语言处理

sgyyuan 发表于 2013-3-22 16:09:19

感谢 ll_j，我对LISP是小白，只是应用需要，从坛里找的，挺好用，就差顺序，如果您没时间细弄，能否请您帮我把每个文本的插入点一块提到表中，我自己在表里按插入点排顺序就行！

vlisp2012 发表于 2013-3-22 19:37:02

感谢 ll_j，这么简洁的表达出来了！

sgyyuan 发表于 2013-3-22 22:27:42

感谢 ll_j！！！！！

太激动了，我没准备大师能帮我啊，一下午，一下午啊，我小心翼翼地把那些字一个一个地选，生怕选大了位置乱了就不好分了啊，没想到 ll_j居然回贴了，而且回得这么彻底，连到表再排序都省了啊！！！

万分感谢 ll_j，你太牛了，顶礼膜拜中

ZZXXQQ 发表于 2013-3-23 08:54:35

一步一步的缩小程序长度：
(mapcar '(lambda (e) (princ e FF) (princ "\n" FF) (mapcar 'car sel));原来的
(mapcar '(lambda (e) (princ (strcat e "\n") FF) (mapcar 'car sel));一改
(mapcar '(lambda (e) (print e FF)) (mapcar 'car sel));二改
(foreach e (mapcar 'car sel) (princ (strcat e "\n") FF));三改
(foreach e (mapcar 'car sel) (print e FF));最后

suiran 发表于 2022-11-14 20:29:19

ll_j 发表于 2013-3-22 17:15

这代码逆天了，简洁明了！

suiran 发表于 2022-11-15 09:41:12

求助大神！！！

本帖最后由 suiran 于 2022-11-15 09:42 编辑

(defun c:Q (/ SS FF I ent e1 ey sel)(if (and (setq SS (ssget '((0 . "*TEXT")))) (if (findfile "d:\\ABC.csv") (setq FF (open "d:\\ABC.csv" "a")) (setq FF (open "d:\\ABC.csv" "w")) ) ) (progn (setq I-1 selnil ) (repeat (sslength SS)(setq i (1+ i) ent (entget (ssname ss i)) e1(cdr (assoc 1 ent)) ey(caddr (assoc 10 ent)) sel (cons (list e1 ey) sel)) ) (setq sel (vl-sort sel '(lambda (y1 y2) (> (cadr y1) (cadr y2))))) (mapcar '(lambda (e) (princ e FF) (princ "\n" ff) ) (mapcar 'car sel) ) (close ff) ))(princ))

各位大侠，我试着修改了一下 ll_j 的这个程序，导出到记事本。浩辰可以正常换行，但是中望就不行了，没有实现换行，程序里面明明有换行符，可是为什么不行呢？不知哪位大侠能否指教？谢谢。

页: [1]

明经CAD社区's Archiver

求助改一下代码，让它能按顺序放

求助大神！！！