自己加载的小程序为什么用不起？
最近在用2007，发现自己添加的个别小应用程序出现了问题，无法使用，具体操作过程如下：“工具”----“加载应用程序”-+--“添加CLOUD.LSP和UNDO.LSP”
提示：加载成功
然后使用CLOUD命令，
提示“命令: cloud ; 错误: *error* 函数中出错参数类型错误: stringp nil”
请高手指点一下，这个是怎么回事？应该怎么改正？
这个小程序我在低版本也在使用，程序应该没有问题的，为何这里用不起了？ 你确认原来可以在2007版本下使用？将你的程序帖一下看看
cloud.lsp
;;;CLOUD.LSP made by xx;;;
;;;DESCRIPTION
;;; Draw cloud and you can specify the globals variables listed below
;;; to decide the characters of cloud
;;;
;;;DATE: 02/18/98; 07/03/98; 07/06/98; 10/19/98; 12/11/98
;;;
;;;HISTORY: Change CLOUD.000 in order to solve the problem of speed
;;; Change CLOUD.001 to use CLAYER to perform the same function
;;; Use the common error routine UNDO.LSP to optimize this program
;;; Use the layer routine LAYCHK to solve the problem of LOCKING & FREEZE
;----------------------------------------------------------------------------
;GLOBALS:
; cloud_layer -- layer of cloud
; cloud_scale -- scale of cloud
; number_rev-- revision number
;----------------------------------------------------------------------------
(defun cloud (/ locked temp first_point next_point relative_point
last_point point_tri point_ref corner_1st corner_2nd length_tri
length_cloud angle_l_to_f dir_tri repeat_count
table_cloud )
(if (and (not undo_init) (equal -1 (load "undo.lsp" -1)))
(progn (alert "Error:\n Cannot find UNDO.LSP.") (exit))
);if
(err_init '("CMDECHO" "OSMODE" "ORTHOMODE" "PLINEWID" "BLIPMODE"
"TEXTSTYLE" "CECOLOR" "CELTYPE" "CLAYER" "REGENMODE") T '(setq l_s nil))
(var_set '(("CMDECHO" 0) ("PLINEWID" 0) ("OSMODE" 0) ("BLIPMODE" 0)
("CECOLOR" "3") ("CELTYPE" "CONTINUOUS") ("REGENMODE" 0)))
(if (not (numberp cloud_scale))
(setq cloud_scale (getvar "LTSCALE"))
); if
(if (not cloud_layer)
(setq cloud_layer (getvar "CLAYER"))
); if
(prompt (strcat "\n默认图层：\"" cloud_layer "\"。" ))
(prompt (strcat "\n默认比例：\"" (rtos cloud_scale 2 2) "\"。"))
(if (= (cdar (laychk cloud_layer)) "No")
(progn
(laychk (setq cloud_layer (getvar "CLAYER")))
(prompt (strcat "\n图层被设为当前层：\"" cloud_layer "\"。" ))
); progn
); if
(while (/= (type first_point) 'LIST)
(initget 1 "Layer Scale")
(setq first_point (getpoint "\n图层 L / 比例 S / <起始点>：") last_point first_point)
(if (= "Scale" first_point)
(progn
(setq temp cloud_scale)
(initget 6)
(cond
( (not (setq cloud_scale (getreal (strcat "\n请输入云彩的比例：<"
(rtos cloud_scale 2 2)
"> "))))
(setq cloud_scale temp) )
); cond
); progn
); if
(if (= "Layer" first_point)
(progn
(setq temp cloud_layer)
(cond
( (= (setq cloud_layer (getstring (strcat "\n请选择图层：<"
cloud_layer "> ")))
"")
(setq cloud_layer temp)
)
); cond
(if (= (cdar (laychk cloud_layer )) "No")
(progn
(setq cloud_layer temp)
(prompt (strcat "\n图层仍为：\"" cloud_layer "\"." ))
); progn
); if
); progn
); if
); while
(setvar "CLAYER" cloud_layer)
(if (>= ( getvar "LUNITS") 3)
(setq length_cloud (* 0.25 cloud_scale)
length_tri (* 0.3125 (getvar "LTSCALE")))
(setq length_cloud (* 0.3406890 cloud_scale)
length_tri (* 0.438366 (getvar "LTSCALE")))
)
(command "_.PLINE" first_point "A")
(while (not (equal next_point first_point 0.000001))
(initget"Close")
(setq next_point (getpoint last_point "\n关闭 C / <下一点>："))
(while (and (not (listp next_point)) (/= next_point "Close"))
(initget"Close")
(setq next_point (getpoint last_point "\n关闭 C / <下一点>："))
)
(if (= "Close" next_point) (setq next_point first_point))
(setq angle_l_to_f (angtos (angle last_point next_point))
relative_point (strcat "@" (rtos length_cloud) "<" angle_l_to_f))
(if (< (setq repeat_count (/ (distance last_point next_point) length_cloud)) 1)
(setq repeat_count 0)
(if (>= (- repeat_count (fix repeat_count)) 0.5)
(setq repeat_count (fix repeat_count))
(setq repeat_count (1- (fix repeat_count)))
); if
); if
(repeat repeat_count (command "A" "-100" relative_point))
(command "A" "-100" next_point)
(setq last_point next_point)
)
(command "")
(if (= (type number_rev) 'INT)
(prompt (strcat "\n默认的版本号：\"" (itoa number_rev) "\"。"))
(progn
(initget 5)
(setq number_rev (getint "\n请输入版本号："))
)
); if
(setvar "OSMODE" 512)
(while (/= (type point_tri) 'LIST)
(initget "Number")
(setq point_tri (getpoint "\n版本号 N / <选择弧上一点>："))
(if (= point_tri "Number")
(progn
(initget 4)
(cond
( (not (setq temp number_rev
number_rev
(getint (strcat "\n请输入版本号：<" (itoa number_rev) "> "))))
(setq number_rev temp)
)
); cond
); progn
); if
); while
(setvar "OSMODE" 0)
(initget 1)
(setq point_ref (getpoint point_tri "\n请选择方向："))
(setq dir_tri (if (> (cos (angle point_ref point_tri)) 0) -1 1))
(setq corner_1st (polar point_tri
(+ 1.570796327 (* -1.570796327 dir_tri))
length_tri
)
)
(setq corner_2nd (polar point_tri
(+ 1.570796327 (* -0.523598775 dir_tri))
length_tri
)
)
(setvar "CECOLOR" "2")
(command "_.pline" point_tri corner_1st corner_2nd "c" )
(setq textstyle (getvar "TEXTSTYLE"))
(command "_.style" "stdtext" "simplex" "0" "1.0" "0" "n" "n" "n")
(setvar "CECOLOR" "7")
(command "_.text" "j" "mc" (polar corner_2nd 4.71238898 (* 0.576 length_tri))
(* 0.4 length_tri) "0" (itoa number_rev))
(layres)
(err_restore)
(princ)
); defun cloud
(defun c:cloud () (cloud))
(defun c:cd () (cloud))
undo.lsp
;;;UNDO.LSP made by piggy;;;
;;;DESCRIPTION
;;; These are general error routines which can be called by
;;; other routine. See AutoCAD 14 ac_bonus.lsp for reference
;;;
;;;SUBROUTINE INCLUDED IN THIS FILE
;;; UNDO_INIT
;;; UNDO_RESTORE
;;; VAR_SAVE
;;; VAR_SET
;;; VAR_RESTORE
;;; ERR_INIT
;;; ERR_MAIN
;;; ERR_RESTORE
;;;
;;;DATE: 10/17/98; 03/31/99
;;;
;;;HISTORY:
;;; Add routine of mod_att
;;;
;;;USING METHOD
;;; ERR_INIT:
;;; This routine initialzes the error handler. It should be called as:
;;;
;;; (if (and (not undo_init)
;;; (equal -1 (load "undo.lsp"-1))
;;; );and
;;; (progn (alert "Error:\n Cannot find UNDO.LSP.")(exit))
;;; ); if
;;;
;;; ARGUMENTS:
;;; err_init Takes 3 arguments.
;;; 1. - The first element of the argument:
;;; This is a list of system variables paired with
;;; the values you want to set them to. i.e. '("CMDECHO" "ATTMODE")
;;; 2. - The second element is a flag
;;; If it is true, then in the event of an error
;;; the custom *error* routine will utilize UNDO
;;; as a cleanup mechanism.
;;; 3. - The third element is a quoted function call.
;;; You pass a quoted call to the function you
;;; wish to execute at the end of nomal routine if an error occurs.
;;; i.e. '(my_special_stuff arg1 arg2...)
;;; Use this arg if you want to do some specialized clean up
;;; things that are not already done by the standard bonus_error
;;; function.
;;;
;;; ERR_MAIN: Body of error routine
;;;
;;; ERR_RESTORE: This routine should be called at the end of command to
;;; restore the VARIABLES, UNDO & *error*.
;;;
;;; UNDO_INIT: Initialize the UNDO status
;;;
;;; UNDO_RESTORE: Restore the UNDO status
;;;
;;; VAR_SAVE: Save the variables. the argument is like '("CMDECHO" "ATTMODE")
;;;
;;; UNDO_set: Set the variables. the argument is like
;;; '(("CMDECHO" 0) ( "ATTMODE" 0))
;;;
;;; UNDO_RESTORE: Restore the variables
;;;
;----------------------------------------------------------------------------
;GLOBALS:
; old_undoctl -- old status of UNDO (voided by UNDO_RESTORE)
; m_lst -- list of variables (voided by VAR_RESTORE)
; err_alive -- indicate error routine is active (voided by ERR_MAIN or
; ERR_OLD)
; err_old -- old handler of *error* (voided by ERR_MAIN or ERR_OLD)
;----------------------------------------------------------------------------
;----------------------------------------------------------------------------
; Modify attributes according to entity name, attribute name, dxf_item
;----------------------------------------------------------------------------
(defun mod_att(ent id dxf_item)
(while (and (/= "ATTRIB" (car (entgetf '(0) ent))) (/= id (car (entgetf '(2) ent))))
(setq ent (entnext ent))
); while
((lambda (x)
(mapcar '(lambda (y)
(setq x (subst y (assoc (car y) x) x))
); lambda
dxf_item
); mapcar
(entmod x)
(entupd ent)
); lambda
(entget ent)
)
); defun mod_att
;----------------------------------------------------------------------------
; Check layer status, return a association list which contains layer information
;----------------------------------------------------------------------------
(defun laychk(lay / l_sta)
( (lambda (x)
(if (not l_s)
(setq l_s (list (cons x (logand 5 (cdr (assoc 70 (tblsearch "LAYER" x)))))))
); if
); lambda
(getvar "CLAYER")
)
(if (not (tblsearch "LAYER" lay))
(progn
(initget "Yes No")
(if (= (setq l_sta (getkword "\n图层不存在，是否建立该图层 ？\(Y/N\)")) "Yes")
(progn
(command "_.layer" "n" lay "")
(setq l_sta 0)
); progn
); if
); progn
(progn
(setq l_sta (logand 5 (cdr (assoc 70 (tblsearch "LAYER" lay)))))
(if (= 1 (logand 1 l_sta))
(progn
(initget "Yes No")
(if (= (getkword "\n该图层被冻结，是否解冻 ？\(Y/N\)") "Yes")
(command "_.layer" "t" lay "")
(setq l_sta "No")
); if
); progn
); if
(if (numberp l_sta)
(if (= 4 (logand 4 l_sta)) (command "_.layer" "u" lay "")); if
); if
); progn
); if
( (lambda (x)
(cond
( (not x)
(setq l_s (cons (cons lay l_sta) l_s))
)
( (= "No" (cdr x))
(setq l_s (subst (cons lay l_sta) x l_s))
)
( T l_s)
); cond
); lambda
(assoc lay l_s)
)
); defun chklay
;----------------------------------------------------------------------------
; Restore layer status according to association list l_s
;----------------------------------------------------------------------------
(defun layres()
(setvar "CLAYER" (car (last l_s)))
(repeat (length l_s)
( (lambda(x)
(if (numberp (cdr x))
(progn
(if (= 4 (logand 4 (cdr x)))
(command "_.layer" "lo" (car x) "")
); if
(if (= 1 (logand 1 (cdr x)))
(command "_.layer" "f" (car x) "")
); if
); progn
); if
); lambda
(car l_s)
)
(setq l_s (cdr l_s))
); repeat
); layres
;----------------------------------------------------------------------------
; Get DXF codes
;----------------------------------------------------------------------------
(defun entgetf (index ent)
((lambda (e)
(mapcar '(lambda (x)
(cdr (assoc x e))
); lambda
index) ; internal lambda function
); lambda
(entget ent)
)
); defun entgetf
;----------------------------------------------------------------------------
; Save UNDO status
;----------------------------------------------------------------------------
(defun undo_init (/ cmdecho undo_ctl)
(setq cmdecho (getvar "CMDECHO") undo_ctl (getvar "UNDOCTL")) ; Save the value
(setvar "CMDECHO" 0)
(if (equal 0 undo_ctl) ; Make sure undo is fully enable
(command "_.undo" "_all")
(command "_.undo" "_control" "_all")
)
(if (equal 4 (logand 4 (getvar "UNDOCTL"))) ; Ensure undo auto is off
(command "_.undo" "_auto" "_off")
)
(while (equal 8 (logand 8 (getvar "UNDOCTL"))) ; Place an end mark here
(command "_.undo" "_end")
)
(while (not (equal 8 (logand 8 (getvar "UNDOCTL"))))
(command "_.undo" "_group")
)
(setvar "CMDECHO" cmdecho)
undo_ctl
); defun undo_init
;----------------------------------------------------------------------------
; Restore UNDO status
;----------------------------------------------------------------------------
(defun undo_restore (/ cmdecho)
(if old_undoctl
(progn
(setq cmdecho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(if (equal 0 (getvar "UNDOCTL")) (command "_.undo" "_all"))
(while (equal 8 (logand 8 (getvar "UNDOCTL")))
(command "_.undo" "_end")
); while
(if (not (equal old_undoctl (getvar "UNDOCTL")))
(progn
(cond
((equal 0 old_undoctl)
(command "_.undo" "_control" "_none")
)
((equal 2 (logand 2 old_undoctl))
(command "_.undo" "_control" "_one")
)
)
(if (equal 4 (logand 4 old_undoctl))
(command "_.undo" "_auto" "_on")
(command "_.undo" "_auto" "_off")
)
)
)
(setq old_undoctl nil)
(setvar "CMDECHO" cmdecho)
)
)
); defun undo_restore
;----------------------------------------------------------------------------
; Save variables
;----------------------------------------------------------------------------
(defun var_save (a)
(setq m_lst '())
(repeat (length a)
(setq m_lst (append m_lst (list (list (car a) (getvar (car a))))))
(setq a (cdr a))
)
); defun var_save
;----------------------------------------------------------------------------
; Set variables
;----------------------------------------------------------------------------
(defun var_set (m_lst)
(repeat (length m_lst)
(setvar (caar m_lst) (cadar m_lst))
(setq m_lst (cdr m_lst))
)
); defun var_set
;----------------------------------------------------------------------------
; Restore variables
;----------------------------------------------------------------------------
(defun var_restore ()
(repeat (length m_lst)
(setvar (caar m_lst) (cadar m_lst))
(setq m_lst (cdr m_lst))
)
); defun var_restore
;----------------------------------------------------------------------------
; Initialize routine
;----------------------------------------------------------------------------
(defun err_init(e_lst u_enable add_fun)
(if err_alive (err_restore)) ; To avoid nested call
(setq err_alive T)
(var_save e_lst) ; Save the modes
(if u_enable (setq old_undoctl (undo_init))) ; Initialize UNDO status
(setq err_old *error* *error* err_main) ; Save the handle of *error*
(if add_fun ; Add the user cleaner
(setq *error* (append (reverse (cdr (reverse *error*)))
(list add_fun (last *error*))
); append
)
)
); defun err_init
undo.lsp(续)
;----------------------------------------------------------------------------; Error routine body
;----------------------------------------------------------------------------
(defun err_main( msg / ) ; Body of error routine
(if (/= msg "Function cancelled") ;If an error (such as CTRL-C) occurs
(princ (strcat "\nError: " s)) ;while this command is active...
)
(while (not (equal (getvar "CMDNAMES") "")) (command nil)) ; Get out of any active command
(if old_undoctl
(progn
(while (not (wcmatch (getvar "CMDNAMES") "*UNDO*")) ; See
(command "_.undo") ; if it's in UNOD command
)
(command "_end")
(command "_.undo" "1")
(while (not (equal (getvar "CMDNAMES") "")) (command nil))
(undo_restore) ; Restore the status of UNDO
)
)
(var_restore) ; Restore the variables
(if err_old (setq *error* err_old err_old nil)) ; Restore the handle of error
(setq err_alive nil)
(princ)
); defun err_main
;----------------------------------------------------------------------------
; Restore error status
;----------------------------------------------------------------------------
(defun err_restore()
(undo_restore) ; Restore the status of UNDO
(var_restore) ; Restore the variables
(if err_old (setq *error* err_old err_old nil)) ; Restore the handle of error
(setq err_alive nil)
(princ)
); defun err_restore 以上两个程序同时加载，在R14版本下面是可以使用的，这点我确定；但是在07是否可以使用，我现在也不确定了，因为这个命令在我用07的时候用的不多，请问版主怎么修改一下可以在07里面使用呢？谢谢指点！ 敢问楼主是否懂得CAD外挂小程序的编程?日常工作中确实有些不太方便的烦琐的操作,我想学习一下,请楼主赐教~~:D :( 楼上的朋友，不好意思哈，我也是菜鸟，不然我就可以自己修改程序了
页:
[1]