- 积分
- 2642
- 明经币
- 个
- 注册时间
- 2003-4-23
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
楼主 |
发表于 2004-11-18 21:16:00
|
显示全部楼层
好的，例程源代码如下：
;;lisp文件：ctk.lsp
;;; ============================插入图框函数===============================
;; 命令名: ctk
;; 作 者: ICEBERG
;; 时 间: 2002年12月
;;;
;;; ===================== load-time error checking ============================
;;;
(defun ai_abort (app msg)
(defun *error* (s)
(if old_error
(setq *error* old_error)
)
(princ)
)
(if msg
(alert
(strcat " Application error: " app " \n\n " msg " \n")
)
)
(exit)
)
;;; Check to see if AI_UTILS is loaded, If not, try to find it,
;;; and then try to load
;;;
;;; If it can't be found or it can't be loaded, then abort the
;;; loading of this file immediately, preserving the (autoload)
;;; stub function.
(cond
((and ai_dcl (listp ai_dcl))) ; it's already loaded.
((not (findfile "ai_utils.lsp")) ; find it
(ai_abort "CTK"
(strcat "Can't locate file AI_UTILS.LSP."
"\n Check support directory."
)
)
)
((eq "failed" (load "ai_utils" "failed")) ; load it
(ai_abort "CTK" "Can't load file AI_UTILS.LSP")
)
)
(if (not (ai_acadapp)) ; defined in AI_UTILS.LSP
(ai_abort "CTK" nil) ; a Nil <msg> supresses
) ; ai_abort's alert box dialog.
;;;
;;; ==================== end load-time operations ===========================
;;;
;;; ====================== 主函数程序 ==============================
(defun c:ctk (/ PaperFile appnames img_number
edt_scale1 edt_scale2 old_cmd old_error
dcl_id but_flag what_next
)
;; =====================初始化==========================
(defun tz_defaults ()
(setq img_number
"0"
but_flag 1
)
(select_name)
(setq appnames '("A0" "A1" "A2" "A3" "A4" "A0加长图框" "清单"))
(start_list "pop_name")
(mapcar 'add_list appnames)
(end_list)
(set_tile "edt_scale1" "1")
(setq edt_scale1 (get_tile "edt_scale1"))
(set_tile "edt_scale2" "1")
(setq edt_scale2 (get_tile "edt_scale2"))
(set_tile "but_hor" "1")
)
;; ======================= 选择图象函数 ==========================
(defun select_name (/ filename)
(cond
((= "5" img_number)
(setq PaperFile "Haf")
)
((= "6" img_number)
(setq PaperFile "New_qd")
)
((= but_flag 1)
(setq PaperFile (strcat "Ha" img_number))
)
(T
(setq PaperFile (strcat "Va" img_number))
)
)
(if (setq filename (findfile "Iceberg.slb"))
(progn
(start_image "image")
(fill_image
0
0
(dimx_tile "image")
(dimy_tile "image")
-16
)
(slide_image
0
0
(dimx_tile "image")
(dimy_tile "image")
(strcat filename "(" PaperFile ")")
)
(end_image)
)
)
)
;;==============图像显示控制函数======================
(defun tk_control ()
(if (or (= "5" img_number) (= "6" img_number))
(progn
(mode_tile "but_hor" 1)
(mode_tile "but_ver" 1)
)
(progn
(mode_tile "but_hor" 0)
(mode_tile "but_ver" 0)
)
)
(select_name)
)
;;===================== 插入图框函数 ==============================
(defun insert_tuzhi (/ InsPoint scale rotate)
(setq PaperFile (findfile (strcat PaperFile ".dwg")))
(if PaperFile
(progn
(setq rotate 0 InsPoint '(0 0)
scale (/ (atof edt_scale2) (atof edt_scale1))
)
(setvar "dimscale" scale)
(setvar "ltscale" scale)
(setvar "clayer" "0")
(repeat 3
(command ".purge" "b" "" "n")
)
(command ".insert" PaperFile InsPoint scale "" rotate)
(command ".zoom" "all")
(command ".explode" "l")
)
(alert "没有找到指定的图框！")
)
)
;;======================= 数据检查函数 ======================
(defun check_tuzhi_data ()
(cond
((or (not edt_scale1) (= "" edt_scale1))
(set_tile "error" " 请输入比例!")
(mode_tile "edt_scale1" 2)
nil
)
((not (distof edt_scale1 2))
(set_tile "error" " 比例只能为数字，请重新输入!")
(mode_tile "edt_scale1" 2)
(mode_tile "edt_scale1" 3)
nil
)
((or (not edt_scale2) (= "" edt_scale2))
(set_tile "error" " 请输入比例!")
(mode_tile "edt_scale2" 2)
nil
)
((not (distof edt_scale2 2))
(set_tile "error" " 比例只能为数字，请重新输入!")
(mode_tile "edt_scale2" 2)
(mode_tile "edt_scale2" 3)
nil
)
(T (done_dialog 2))
)
)
;;========================== 控件驱动函数 ============================
(defun insert_tuzhi_main ()
(setq what_next 4)
(while (< 2 what_next)
(if (not (new_dialog "ctk" dcl_id))
(exit)
)
(tz_defaults)
(action_tile
"pop_name"
"(rs_error)(setq img_number $value)(tk_control)"
)
(action_tile
"but_hor"
"(rs_error)(setq but_flag 1)(select_name)"
)
(action_tile
"but_ver"
"(rs_error)(setq but_flag 2)(select_name)"
)
(action_tile
"edt_scale1"
"(rs_error)(setq edt_scale1 $value)"
)
(action_tile
"edt_scale2"
"(rs_error)(setq edt_scale2 $value)"
)
(action_tile "accept" "(check_tuzhi_data)")
(action_tile "cancel" "(done_dialog 0)")
(setq what_next (start_dialog))
) ;end while
;; If OK was picked...
(if (= what_next 2)
(insert_tuzhi)
)
)
;;=========== 清除错误信息 ===========
(defun rs_error ()
(set_tile "error" "")
)
;;==========容错函数=======
(defun MyError (msg)
(if (or (= msg "Function cancelled")
(= msg "quit / exit abort")
(= msg "函数被取消")
(= msg "函数已取消")
)
(princ)
(princ (strcat "\n 错误:" msg "\n"))
)
(setvar "clayer" clayer)
(setvar "cmdecho" old_cmd)
(princ)
)
;;
;; ====================== 主函数程序 ==============================
;;
(setq old_cmd (getvar "cmdecho") ; save current setting of cmdecho
clayer (getvar "clayer")
old_error *error*
*error* MyError
)
(setvar "cmdecho" 0)
(cond
((not (ai_notrans))) ; transparent not OK
((not (setq dcl_id (ai_dcl "ctk"))))
(T
(graphscr)
(ai_undo_push)
(insert_tuzhi_main) ; proceed!
(ai_undo_pop)
)
)
(setq *error* old_error)
(setvar "clayer" clayer)
(setvar "cmdecho" old_cmd)
(princ)
)
;;;--------------------------------------------------------------
(princ " 插入图框程序已装载！")
(princ)
;;dcl文件:ctk.dcl
// 图框对话框驱动程序 //
ctk : dialog {
label="插入图框";
: boxed_column {
label="预览";
: image {
key="image" ;
// width = 16 ;
height = 9 ;
}
}
: boxed_column {
label="图幅";
: row {
: popup_list {
key="pop_name" ;
}
: radio_row {
: radio_button {
label="横幅";
key="but_hor";
}
: radio_button {
label="竖幅";
key="but_ver";
}
}
}
}
: boxed_column {
label="比例";
: row {
: edit_box {
key="edt_scale1";
}
: text {
label=" :";
}
: edit_box {
key="edt_scale2";
}
}
}
spacer;
spacer;
ok_cancel_err;
}
希望诸位高手编译后能告诉我怎么是对话框显现出来。谢谢！！ |
|
[复制链接]
发表于 2004-11-18 19:15:00
显身卡
