[求助] 求个LISP小程序
本帖最后由 作者 于 2010-5-11 19:58:33 编辑 <br /><br /> <p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: -21pt;"></p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: -21pt;">界面如图：</p><p class="MsoNormal" style="MARGIN: 0cm 0cm 0pt 21pt; TEXT-INDENT: -21pt;">功能：宗地编号和四至可以直接在<font face="Times New Roman">cad</font>图上选择文字或输入，然后每次生成一条记录，生成电子表格或者是数据库格式。</p> 今天边看NBA边随便写了下，不知道合不合你用，可惜太阳输了...(defun c:Test
(/ BZ DZ ID NZ OBJ STD SZ ZDBH Temp_Fold Temp_File Temp_Dcl)
(if (findfile "Lisp_Function.VLX")
(load "Lisp_Function.VLX")
)
;;; Lisp_Function.VLX 可于 http://e.ys168.com/?ls0201 下载
;;; 主要是一些常用的函数打包，包括Excel处理函数，部分来源于网络 ^_^
(setq Temp_Fold (getenv "Temp")) ;_临时文件
(setq Temp_File (strcat Temp_Fold "\\20100518_宗地编号_Tmp.txt"))
(setq Temp_Dcl (strcat Temp_Fold "\\20100518_宗地编号.dcl"))
;;;--------------------------------------------------------------;;;
;;; Start ;;;
;;;--------------------------------------------------------------;;;
;;; 设置对话框的值
(defun set_dialog (zdbh dz nz sz bz / file)
(if zdbh
(set_tile "zdbh" zdbh)
)
(if dz
(set_tile "dz" dz)
)
(if nz
(set_tile "nz" nz)
)
(if sz
(set_tile "sz" sz)
)
(if bz
(set_tile "bz" bz)
)
(setq file Temp_File)
(if (findfile Temp_File)
(progn
(set_tile
"Show_Info"
(strcat "当前临时记录文件宗地数: "
(rtos (/ (length (at_file_to_list_st file)) 5) 2 0)
)
)
)
)
)
;;; 新建临时记录文件
(defun New_File ()
(if (= (NewDialog1 " 是否新建记录文件?") 1)
(progn
(close (open Temp_File "w"))
(set_tile "Show_Info" "当前临时记录文件宗地数: 0")
(alert " 建立成功")
)
(progn
(alert " 建立失败")
)
)
)
;;; 记录宗地信息
(defun S_This (/ BZ DZ FILE FN F_NUM NZ P_LIST R_LIST SZ X ZDBH)
(setq file Temp_File)
(setq zdbh (get_tile "zdbh"))
(if (/= zdbh "")
(progn
(setq dz (get_tile "dz"))
(setq nz (get_tile "nz"))
(setq sz (get_tile "sz"))
(setq bz (get_tile "bz"))
(setq p_list (strcat zdbh "\n" dz "\n" nz "\n" sz "\n" bz "\n"))
(if (findfile file)
(progn
(if (setq f_num (Get_Txt_Num_File file zdbh))
(progn
(if (= (NewDialog1 " 是否替换原有宗地?") 1) ;_替换
(progn
;;; (setq r_list (reverse (readfile_to_list file)))
(setq r_list (reverse (at_file_to_list_st file)))
(setq
r_list (lt:list-subst-n r_list (- f_num 1) zdbh)
)
(setq r_list (lt:list-subst-n r_list f_num dz))
(setq
r_list (lt:list-subst-n r_list (+ f_num 1) nz)
)
(setq
r_list (lt:list-subst-n r_list (+ f_num 2) sz)
)
(setq
r_list (lt:list-subst-n r_list (+ f_num 3) bz)
)
(setq fn (open file "w"))
(mapcar '(lambda (x) (princ (strcat x "\n") fn))
r_list
)
(close fn)
)
)
)
(progn
(setq fn (open file "a"))
(princ p_list fn)
(close fn)
)
)
)
(progn
(setq fn (open file "a"))
(princ p_list fn)
(close fn)
)
)
(set_tile "Show_Info"
(strcat "当前临时记录文件宗地数: "
(itoa (/ (length (at_file_to_list_st file)) 5))
)
)
)
(progn
(alert "宗地编号也得有吧...")
)
)
)
;; 确认覆盖原宗地对话框
(defun NewDialog1 (info / id std)
(setq id
(load_dialog
Temp_Dcl
)
)
(new_dialog "New_Tab" id)
(set_tile "New_D_info" info)
(setq std (start_dialog))
(unload_dialog id)
std
)
;;; 输出到Excel文件
(defun out_put
(/ *XLAPP* FILE FILE_TMP I R_LIST XLS_LIST XLS_TMP isopen)
(setq file_tmp Temp_File)
(if (findfile file_tmp)
(progn
(alert (strcat "输出前请保存你正在编辑的Excel文件\n\n 转出完成后会关闭所有Excel程序!"))
(setq file (getfiled "输入文件名" "c:\\" "xls" 1))
(if (and file (setq isopen (open file "w")))
(progn
(close isopen)
(if (setq r_list (at_file_to_list_st file_tmp))
(progn
(setq r_list (reverse r_list))
(setq i 0)
(setq xls_tmp '())
(setq xls_list (list))
(foreach r_list_i r_list
(setq xls_tmp (append (list r_list_i) xls_tmp))
(if (= i 4)
(progn
(setq xls_list
(append (list (reverse xls_tmp)) xls_list)
)
(setq xls_tmp '())
(setq i -1)
)
)
(setq i (1+ i))
)
(setq xls_list (reverse xls_list))
(setq *xlapp* (vlxls-app-open file nil))
(vlxls-cell-put-value
*xlapp*
(strcat "A1:E" (itoa (/ (length r_list) 5)))
xls_list
)
(vlxls-app-save *xlapp*)
(vla-put-visible *xlapp* 1)
(vlxls-app-quit *xlapp* nil)
(alert (strcat "文件已保存到\n" file))
)
(progn
(alert "文件中没有记录,请先录入")
)
)
)
(progn
(alert "没有选择文件或文件处于使用状态")
)
)
)
(progn
(alert "没有记录信息,请重新录入")
)
)
(princ)
)
;;; 生成DCL文件
(defun dcl_s (/ file fn f_list F_LIST_1 F_LIST_0)
(setq file Temp_Dcl)
(setq fn (open file "w"))
(setq f_list
(strcat
"
dcl_settings : default_dcl_settings { audit_level = 3; }
ZdData : dialog {
value = \"By ls...\";
initial_focus = \"button_cen\";
: image_button {
key = \"image_button_a\";
aspect_ratio = 0.01;
width = 50;
}
:row{
alignment = right;
: edit_box {
label = \"编 号:\";
key = \"zdbh\";
edit_width = 30;
}
: button {
label = \"选择(Z)\";
key = \"select_zdbh\";
mnemonic = \"Z\";
// action = \"select_zdbh\";
}
}
:row{
alignment = right;
: edit_box {
label = \"东 至:\";
key = \"dz\";
edit_width = 30;
}
: button {
label = \"选择(D)\";
key = \"select_dz\";
mnemonic = \"D\";
// action = \"select_dz\";
}
}
:row{
: edit_box {
label = \"南 至:\";
key = \"nz\";
edit_width = 30;
}
: button {
label = \"选择(N)\";
key = \"select_nz\";
mnemonic = \"N\";
// action = \"select_nz\";
}
}
:row{
: edit_box {
label = \"西 至:\";
key = \"sz\";
edit_width = 30;
}
: button {
label = \"选择(S)\";
key = \"select_sz\";
mnemonic = \"S\";
// action = \"select_sz\";
}
}
:row{
: edit_box {
label = \"北 至:\";
key = \"bz\";
edit_width = 30;
}
: button {
label = \"选择(B)\";
key = \"select_bz\";
mnemonic = \"B\";
// action = \"select_bz\";
}
}
" )
)
(setq f_list_0
(strcat
": spacer {
}
: row {
:button {
label = \"新建文件\";
key = \"New_File\";
fixed_width = true;
}
: button {
label = \"记录此宗地(O)\";
key = \"S_This\";
mnemonic = \"O\";
}
}
:text {
label=\"当前临时记录文件宗地数:\" ;
key=\"Show_Info\";
}
: spacer {
}
: row {
: button {
label = \"写入Excel文件(W)\";
key = \"button_ok\";
mnemonic = \"W\";
}
: button {
label = \"取 消(C)\";
key = \"cancel\";
mnemonic = \"C\";
is_default = true;
is_cancel = true;
}
}
: image_button {
key = \"image_button_b\";
aspect_ratio = 0.01;
width = 50;
}
}" )
)
(setq f_list_1
(strcat
"New_Tab : dialog {
value = \"确认信息\";
spacer;
:text
{label=\"信息显示\" ;
key = \"New_D_info\";
}
ok_cancel;
}" )
)
(princ f_list fn)
(princ f_list_0 fn)
(princ f_list_1 fn)
(close fn)
)
;;;--------------------------------------------------------------;;;
;;; End ;;;
;;;--------------------------------------------------------------;;;
;;; 主程序
(dcl_s)
(setq id
(load_dialog
Temp_Dcl
)
)
(if (< id 0)
(exit)
)
(setq std 10)
(while (> std 0)
(if (not (new_dialog "ZdData" id))
(exit)
)
(action_tile "select_zdbh" "(done_dialog 1)")
(action_tile "select_dz" "(done_dialog 2)")
(action_tile "select_nz" "(done_dialog 3)")
(action_tile "select_sz" "(done_dialog 4)")
(action_tile "select_bz" "(done_dialog 5)")
(action_tile "New_File" "(New_File)")
(action_tile "S_This" "(S_This)")
;;; (action_tile "button_ok" "(out_put)(done_dialog 0)")
(action_tile "button_ok" "(out_put)")
(action_tile "cancel" "(done_dialog 0)")
(set_dialog zdbh dz nz sz bz)
(setq std (start_dialog))
(cond
((= std 1)
(while (not (setq obj (entsel "\n选择宗地号:"))))
(setq zdbh (cdr (assoc 1 (entget (car obj)))))
)
((= std 2)
(while (not (setq obj (entsel "\n选择东至:"))))
(setq dz (cdr (assoc 1 (entget (car obj)))))
)
((= std 3)
(while (not (setq obj (entsel "\n选择南至:"))))
(setq nz (cdr (assoc 1 (entget (car obj)))))
)
((= std 4)
(while (not (setq obj (entsel "\n选择西至:"))))
(setq sz (cdr (assoc 1 (entget (car obj)))))
)
((= std 5)
(while (not (setq obj (entsel "\n选择北至:"))))
(setq bz (cdr (assoc 1 (entget (car obj)))))
)
)
)
(unload_dialog id)
(princ)
)
<p>谢谢了，可我加载第一次可以用，以后加载就用不了了，怎么回事呢，而且生成的文件打不开</p><p>能不能麻烦解决下</p> <p>1、不能用有什么提示？</p><p>2、文件 Lisp_Function.VLX 放到CAD的搜索目录没有？</p><p>3、生成的Excel文件，你电脑上有没有装OFFICE的Excel？</p> <p>具体也不好说清楚，如果你有空的话，请指教下</p><p>qq：280462207</p> 高手啊，随便写写就出来了 高手啊，随便写写就出来了
页:
[1]