找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 655|回复: 2

[编程申请]:各位老师,有个ACAD料表与文本文件互读转换的LSP程序。

[复制链接]
发表于 2004-10-17 03:32:01 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
各位老师,有个ACAD料表与文本文件互读转换的LSP程序,是一个以前的同事编写的,在ACAD R14中非常好用,在ACAD2000中,“读料表形成文本文件”还好用,但“读文本文件填写料表”就不好用了。

料表的格式,是我单位的格式,分7列,分别为件号、图号或标准号、名称及规格、数量、材料、质量/单、质量/总、备注。

这个程序是ACAD料表与TXT文件互读,不利于料表的修改及计算。

哪位老师能帮忙修改一下,使其成为ACAD与EXCEL之间互读的程序?


原程序如下:

;;;keep SYS VIR to MLST
(defun modes(a) (setq mlst nil);mlst-global viriable
(repeat (length a)
  (setq mlst (append mlst (list (list (car a) (getvar (car a))))))
(setq a (cdr a))))
(defun moder();;;restore MLST to SYS VIR
(repeat (length mlst)
  (setvar (caar mlst) (cadar mlst)) (setq mlst (cdr mlst))))
(defun myerr(s);;;faulse treat function
(if (/= s "Function cancelled")
  (if (/= s "quit / exit abort") (princ (strcat "\nerror:" s))))
(moder) (setq *error* olderr) (princ))


;;;Filename:wdata.lsp,By Huang hong jun,DPDI,1998-07-03
;;;Function:读料表,形成文本文件
;;;*********************************************************************************
;;Sub programs:
;;filename:aw.lsp
;;function:格式化字符串s-字符串,w-场宽
(defun aw(s w)
(if (> w (strlen s)) (repeat (- w (strlen s)) (setq s (strcat s " "))));end if
s );end defun

;;Main programs:
(defun c:wdata(/ fname fp hs p0 p1 pp0 pp1 pp2 n i j ss x1_lst x2_lst w1_lst txt)
(modes '("blipmode" "cmdecho" "osmode" "clayer"))
(setq olderr *error* *error* myerr)
(mapcar 'setvar '("cmdecho" "osmode") '(0 33))
(setq fname (getfiled "输出文件名(必须有扩展文件名)" "c:/" "*" 1))
(setq p0 (getpoint "\n点取第一个件号的左下角点:")
       p1 (getpoint p0 "\n点取(明细表栏)右上角点:"))
(prompt "\n请稍等片刻!!!")
(setvar "osmode" 0) (command "zoom" "w" p0 p1)
(setq hs (fix (/ (+ (abs (- (cadr p1) (cadr p0))) 4) 8)))
(setq fp (open fname "w"))
(setq i 1)
(while (< i (1+ hs))
  (setq pp0 (list (car p0) (+ (cadr p0) (* 8 (1- i))))
        pp1 (list (+ (car p0) 180) (+ (cadr p0) (* 8 i)))
        pp2 (list (car p0) (+ (cadr p0) (* 8 i))));end s
  (setq x1_lst (list pp0 (polar pp0 0 20) (polar pp0 0 50) (polar pp0 0 95)
   (polar pp0 0 105) (polar pp0 0 135) (polar pp0 0 145) (polar pp0 0 155)))
  (setq x2_lst (list (polar pp2 0 20) (polar pp2 0 50) (polar pp2 0 95)
    (polar pp2 0 105) (polar pp2 0 135) (polar pp2 0 145) (polar pp2 0 155) pp1))
  (setq w1_lst nil n 0)
  (while (< n 8)
   (setq ss (ssadd)
         ss (ssget "W" (nth n x1_lst) (nth n x2_lst)
                  (list (cons 0 "TEXT") (cons -4 ">") (cons 40 3.5)))
   );end setq
   (if (/= ss nil) (setq txt (cdr (assoc 1 (entget (ssname ss 0))))) (setq txt " "));end if
   (setq w1_lst (append w1_lst (list txt)))
   (setq n (1+ n))
  );end w
  (princ (aw (nth 0 w1_lst) 8) fp) (princ "," fp)
  (princ (aw (nth 1 w1_lst) 10) fp) (princ "," fp)
  (princ (aw (nth 2 w1_lst) 20) fp) (princ "," fp)
  (princ (aw (nth 3 w1_lst) 4) fp) (princ "," fp)
  (princ (aw (nth 4 w1_lst) 12) fp) (princ "," fp)
  (princ (aw (nth 5 w1_lst) 6) fp) (princ "," fp)
  (princ (aw (nth 6 w1_lst) 6) fp) (princ "," fp)
  (princ (aw (nth 7 w1_lst) 16) fp) (princ "\n" fp)
  (setq i (1+ i))
);end w
(setq ss nil)
(close fp)
(moder) (setq *error* older) (princ)
(alert (strcat "程序运行正确,谢谢使用!\n\n请指点[确定]按钮退出!!"
                "\n\n结果保存在 {" fname "} 文件中!!!"))
);end WDATA.LSP

;;;Filename:rdata.lsp,By Huang hong jun,DPDI,4-23-1998
;;;Function:读文本文件,填写料表
;;;**********************************************************************************
;;SUB Programs:
;;Filename:chw.lsp
;;给定长度,改变最后文本的宽度
(defun chw(kd cd / tb pt1 pt2 ed jkd xkd x)
(setq ed (entget(entlast)))
(setq ed (subst (cons 41 kd) (assoc 41 ed) ed))
(entmod ed)
(setq jkd (cdr (assoc 41 ed)))
(setq tb (textbox ed)  pt1 (car tb)  pt2 (cadr tb))
(setq x (abs (- (car pt2) (car pt1))))
(if (> x cd) (progn
  (setq xkd (* (/ cd x) jkd))
  (setq ed (subst (cons 41 xkd) (assoc 41 ed) ed))
  (entmod ed) );end p
);end if
(princ)
);end defun
;;FileName:cut_str.lsp
;;Function:去掉字符串前后的空格
(defun cut_str(str / n n1 n2 m ii c-str tmpstr n_lst)
(if (= str nil) (setq c-str " ")
  (progn
   (setq n (strlen str) ii 1 c-str nil n_lst nil)
   (while (< ii (1+ n))
    (setq tmpstr (substr str ii 1))
    (if (/= tmpstr " ") (setq n_lst (append n_lst (list ii))) );end if
    (setq ii (1+ ii))
   );end w
   (if (= n_lst nil) (setq c-str " ")
   (setq n1 (nth 0 n_lst) n2 (last n_lst) c-str (substr str n1 (1+ (- n2 n1))))
   );end if
  );end p
);end if
c-str
);end defun
;;Filename:dh_sl.lsp
;;Function:计算大字串中","的个数
(defun dh_sl(d_str / n i dh_sl tmpstr)
(if (/= d_str nil) (setq n (strlen d_str) i 0 dh_sl 0))
(while (< i n)
  (setq tmpstr (substr d_str (1+ i) 1))
  (if (= tmpstr ",") (setq dh_sl (1+ dh_sl)))
  (setq i (1+ i)));end w
dh_sl);end
;;Filename:cw_jc.lsp
;;Filename:检查文本文件中的数据错误,给出错所在行号并退出程序,没错返回总行数
(defun cw_jc(fname n / f yi l_lum cw_lst m i str)
(setq f (open fname "r"))
(setq yi (read-line f) l_num 1 cw_lst nil)
(while yi
  (if (/= (strlen (cut_str yi)) 0);空行
   (if (/= (dh_sl yi) n) (setq cw_lst (append cw_lst (list l_num))))
  );end if
  (setq l_num (1+ l_num))
  (setq yi (read-line f))
);end w
(close f)
(setq l_num (1- l_num))
(prompt (strcat "\n文件 " fname " 共有 {" (itoa l_num) "}行."))
(if (/= cw_lst nil) (progn
  (setq m (length cw_lst) i 0 str " ")
  (while (< i m) (setq str (strcat str (itoa (nth i cw_lst)) ";") i (1+ i)))
  (alert (strcat "数据文件中第" str " 行数据有错误!"
                 "\n\n错误原因是可能空白行、少(多)项、或逗号不匹配!!"
                 "\n\n逗号应为" (itoa n) "个,请检查文件!!!"))
  (exit) );end p
);end if
l_num
);end defun
;;FileName:fj_str.lsp
;;Function:读出大字串中的每个字符,合成一个表
(defun fj_str(d_str / n i n_lst tmpstr s1 s2 s3 s4 s5 s6 s7 s8 n_lis)
(if (/= d_str nil) (setq n (strlen d_str) i 1 n_lis nil))
(while (< i (1+ n))
  (setq tmpstr (substr d_str i 1))
  (if (= tmpstr ",") (setq n_lst (append n_lst (list i))));end if
  (setq i (1+ i))
);end w
(setq s1 (substr d_str 1 (1- (nth 0 n_lst)) )
       s2 (substr d_str (1+ (nth 0 n_lst)) (- (nth 1 n_lst) (nth 0 n_lst) 1) )
       s3 (substr d_str (1+ (nth 1 n_lst)) (- (nth 2 n_lst) (nth 1 n_lst) 1) )
       s4 (substr d_str (1+ (nth 2 n_lst)) (- (nth 3 n_lst) (nth 2 n_lst) 1) )
       s5 (substr d_str (1+ (nth 3 n_lst)) (- (nth 4 n_lst) (nth 3 n_lst) 1) )
       s6 (substr d_str (1+ (nth 4 n_lst)) (- (nth 5 n_lst) (nth 4 n_lst) 1) )
       s7 (substr d_str (1+ (nth 5 n_lst)) (- (nth 6 n_lst) (nth 5 n_lst) 1) )
       s8 (substr d_str (1+ (nth 6 n_lst)) )
);end setq
(setq n_lis (append n_lis (list (cut_str s1) (cut_str s2) (cut_str s3) (cut_str s4)
  (cut_str s5) (cut_str s6) (cut_str s7) (cut_str s8))))
n_lis
);end
;;;搜索图层,返回所有的层名表l_lst
(defun lname(/ xi lname l_lst)
(setq xi (tblnext "layer" t) l_lst nil)
(while xi
  (setq lname (cdr (assoc 2 xi)))
  (setq l_lst (append l_lst (list lname)))
  (setq xi (tblnext "layer" nil))
);end w
l_lst);end lname.lsp

;;;Main programs:
(defun c:rdata(/ pc p1 p2 p3 p4 p5 p6 p7 p8 hs zc0 zc1 zc2 zc3 zc4
                 zc5 zc6 zc7 fname f xi i n_lst)
(modes '("blipmode" "cmdecho" "orthomode" "osmode" "clayer" "plinewid"))
(setq olderr *error* *error* myerr)
(mapcar 'setvar '("cmdecho" "osmode") '(0 33))
(if (member "_TEXT" (lname)) (setvar "clayer" "_TEXT")
     (command "layer" "m" "_TEXT" "c" 3 "" ""));end if,lname-sub
(setq fname (getfiled "输入文件名" "c:/" "*" 0))
(prompt "\n程序运行需要10~30秒,请稍等片刻!!!")
(setq pc (getpoint "\n第一个件号左下角点:"))
(setq hs (cw_jc fname 7));sub 检查数据文件的错误
(setvar "osmode" 0)
(command "zoom" pc (list (+ (car pc) 180) (+ (cadr pc) (* (1+ hs) 8))))
(setq f (open fname "r"))
(setq xi (read-line f) i 0)
(while xi
  (setq n_lst (fj_str xi))
  (setq p1 (list (+ (car pc) 10) (+ (cadr pc) 4 (* i 8)))
        p2 (list (+ (car pc) 23) (+ (cadr pc) 4 (* i 8)))
        p3 (list (+ (car pc) 55) (+ (cadr pc) 4 (* i 8)))
        p4 (list (+ (car pc) 100) (+ (cadr pc) 4 (* i 8)))
        p5 (list (+ (car pc) 120) (+ (cadr pc) 4 (* i 8)))
        p6 (list (+ (car pc) 140) (+ (cadr pc) 4 (* i 8)))
        p7 (list (+ (car pc) 150) (+ (cadr pc) 4 (* i 8)))
        p8 (list (+ (car pc) 158) (+ (cadr pc) 4 (* i 8))) );end setq
  (setq zc0 (nth 0 n_lst) zc1 (nth 1 n_lst) zc2 (nth 2 n_lst) zc3 (nth 3 n_lst)
        zc4 (nth 4 n_lst) zc5 (nth 5 n_lst) zc6 (nth 6 n_lst) zc7 (nth 7 n_lst))
  (command "text" "j" "m"  p1 5 0 zc0)
  (if (and (/= zc0 nil) (/= zc0 " ")) (chw 0.5 18.0))
  (command "text" "j" "ml" p2 5 0 zc1)
  (if (and (/= zc1 nil) (/= zc1 " ")) (chw 0.5 25.0))
  (command "text" "j" "ml" p3 5 0 zc2)
  (if (and (/= zc2 nil) (/= zc2 " ")) (chw 0.7 38.0))
  (command "text" "j" "m"  p4 5 0 zc3)
  (if (and (/= zc3 nil) (/= zc3 " ")) (chw 0.5 8.5))
  (command "text" "j" "m"  p5 5 0 zc4)
  (if (and (/= zc4 nil) (/= zc4 " ")) (chw 0.5 28.0))
  (command "text" "j" "m"  p6 5 0 zc5)
  (if (and (/= zc5 nil) (/= zc5 " ")) (chw 0.4 8.5))
  (command "text" "j" "m"  p7 5 0 zc6)
  (if (and (/= zc6 nil) (/= zc6 " ")) (chw 0.4 8.5))
  (command "text" "j" "ml" p8 5 0 zc7)
  (if (and (/= zc7 nil) (/= zc7 " ")) (chw 0.5 21.0))
  (setq xi (read-line f) i (1+ i))
);end w
(close f)
(moder) (setq *error* older) (princ)
);end of RDATA.LSP


读出的料表文本示例:
1       ,JB/T4712-92,鞍座 BI2400-F       ,1   ,组合件      ,      ,336   ,               
2       ,          ,支承角钢(1) ∠80x80x8,4   ,Q235-A      ,4.0   ,16.2  ,L=375           
3       ,SB09-2    ,支承角钢(2) ∠80x80x8,3   ,Q235-A      ,6.4   ,19.2  ,L=600           
4       ,SB09-2    ,U型螺栓 M10         ,8   ,Q235-B      ,0.1   ,0.8   ,               
5       ,GB6170-86 ,螺母 M10            ,16  ,5           ,0.008 ,0.1   ,               
6       ,          ,加热管 %%C32X3.5    ,1   ,10          ,      ,7.8   ,L=3560         
7       ,SB09-2    ,内部斜梯 NT-2400    ,2   ,组合件      ,26    ,52    ,               
8       ,JB/T4746-2002,封头 EHA2400x10     ,2   ,Q235-B      ,502.2 ,1004  ,            
9       ,          ,筒体 %%C2400 δ=8   ,1   ,Q335-B      ,      ,2945  ,L=6200         



料表图例:
笨到家了,修改了N遍,依然图片显示为红叉。:(

                               
登录/注册后可看大图
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 593个

财富等级: 财运亨通

发表于 2004-10-17 09:29:45 | 显示全部楼层
转来转去的多麻烦,选中EXCEL后在ACAD中粘贴为OLE
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2004-10-17 23:57:47 | 显示全部楼层
谢谢eachy斑竹。
按表格各列比例定义列宽,把EXCEL粘贴为OLE,出图效果不理想。
还是需要转成CAD文件。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2025-9-27 13:46 , Processed in 0.300028 second(s), 34 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

快速回复 返回顶部 返回列表