自己加载的小程序为什么用不起？

coeficient · 发表于 2007-3-12 15:01

最近在用2007，发现自己添加的个别小应用程序出现了问题，无法使用，具体操作过程如下：
“工具”----“加载应用程序”-+--“添加CLOUD.LSP和UNDO.LSP”
提示：加载成功
然后使用CLOUD命令，
提示“命令: cloud ; 错误: *error* 函数中出错参数类型错误: stringp nil”
请高手指点一下，这个是怎么回事？应该怎么改正？
这个小程序我在低版本也在使用，程序应该没有问题的，为何这里用不起了？

cad · 发表于 2007-3-12 15:09

你确认原来可以在2007版本下使用？将你的程序帖一下看看

coeficient · 发表于 2007-3-13 08:30

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

coeficient · 发表于 2007-3-13 08:33

;;;  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

coeficient · 发表于 2007-3-13 08:34

;----------------------------------------------------------------------------
; 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

coeficient · 发表于 2007-3-13 08:40

以上两个程序同时加载，在R14版本下面是可以使用的，这点我确定；但是在07是否可以使用，我现在也不确定了，因为这个命令在我用07的时候用的不多，请问版主怎么修改一下可以在07里面使用呢？谢谢指点！

胜油固井 · 发表于 2007-3-13 08:49

敢问楼主是否懂得CAD外挂小程序的编程?日常工作中确实有些不太方便的烦琐的操作,我想学习一下,请楼主赐教~~

coeficient · 发表于 2007-3-13 12:23

楼上的朋友，不好意思哈，我也是菜鸟，不然我就可以自己修改程序了

		自动登录	找回密码
密码			立即注册

[求助] 自己加载的小程序为什么用不起？

cloud.lsp

undo.lsp

undo.lsp(续)