[求助] 求个LISP小程序

malianxnkj · 发表于 2010-5-11 18:05:00

本帖最后由作者于 2010-5-11 19:58:33 编辑

界面如图：

功能：宗地编号和四至可以直接在cad图上选择文字或输入，然后每次生成一条记录，生成电子表格或者是数据库格式。

gufeng · 发表于 2010-5-18 11:52:00

今天边看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)
)

(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)
)

malianxnkj · 发表于 2010-5-18 21:50:00

谢谢了，可我加载第一次可以用，以后加载就用不了了，怎么回事呢，而且生成的文件打不开

能不能麻烦解决下

gufeng · 发表于 2010-5-19 12:11:00

1、不能用有什么提示？

2、文件 Lisp_Function.VLX 放到CAD的搜索目录没有？

3、生成的Excel文件，你电脑上有没有装OFFICE的Excel？

malianxnkj · 发表于 2010-5-19 17:59:00

具体也不好说清楚，如果你有空的话，请指教下

qq：280462207

hehaidizhi · 发表于 2010-5-23 21:23:00

高手啊，随便写写就出来了

jslxt · 发表于 2011-10-22 20:04:15

高手啊，随便写写就出来了

账号		自动登录	找回密码
密码			注册

[求助] 求个LISP小程序

本帖子中包含更多资源