- UID
- 295774
- 积分
- 0
- 精华
- 贡献
-
- 威望
-
- 活跃度
-
- D豆
-
- 在线时间
- 小时
- 注册时间
- 2005-7-19
- 最后登录
- 1970-1-1
|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
内容如下
;; 覆盖tangent\tch\sys\下的同名文件即可。
;; liukai 2001.10.15
(defun c:- () (command "_.zoom" "0.8x") (princ))
(defun c:= () (command "_.zoom" "1.25x") (princ))
;; Change slected objects to current layer
(defun C:LK-LA-OBJ2CLAYER ( / oldvar e-sel)
(setq oldvar (getvar "CMDECHO"))
(while (setq e-sel (ssget))
(setvar "CMDECHO" 0)
(command "_.change" e-sel ""
"_p"
"_la" (getvar "CLAYER")
"_c" "BYLAYER"
"_lt" "BYLAYER"
""
)
(setvar "CMDECHO" oldvar)
)
(setvar "CMDECHO" oldvar)
(princ)
);end defun C:LK-LA-OBJ2CLAYER
(defun C:5 ()
(C:LK-LA-OBJ2CLAYER)
(princ)
)
(defun c:4 ( / esl en el sLayer)
(if (setq esl (entsel "\nPlease pick a object:"))
(progn
(setq en (car esl)
el (entget en)
sLayer (cdr (assoc 8 el))
)
(setvar "CLAYER" sLayer)
(princ (strcat "\nCurrent layer is : " sLayer))
)
);end if
(princ)
)
(defun C:LK-LA-PICKOFF ( / oldvar cla esel en el ela)
(setq oldvar (getvar "CMDECHO")
cla (getvar "CLAYER")
)
(while (setq esel (entsel))
(setq en (car esel)
el (entget en)
ela (cdr (assoc 8 el))
)
(if (/= ela cla)
(progn
(setvar "CMDECHO" 0)
(command "_.layer" "_off" ela "")
(setvar "CMDECHO" oldvar)
)
);end if
);end while
(setvar "CMDECHO" oldvar)
(princ)
)
(defun C:6 ()
(C:LK-LA-PICKOFF)
(princ)
)
;; All layers turn on
(defun C:LK-LA-ALLON ( / oldvar)
(setq oldvar (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(command "_.layer" "_on" "*" "")
(princ "\nAll layers on.")
(setvar "CMDECHO" oldvar)
(princ)
);end defun C:LK-LA-ALLON
(defun c:7 ()
(C:LK-LA-ALLON)
(princ)
)
(defun c:qq ( / ss)
(if (setq ss (ssget))
(command "_.pedit" ss "_y" "_j" "_p" "" "")
)
(princ)
)
(defun c:as (/ ss nCount oldvar en el elay)
(if (setq ss (ssget))
(progn
(setq nCount (1- (sslength ss))
oldvar (getvar "CMDECHO")
)
(setvar "CMDECHO" 0)
(command "_.layer" "_off" "*" "_y" "")
(while (>= nCount 0)
(setq en (ssname ss nCount)
el (entget en)
elay (cdr (assoc 8 el))
)
(command "_.layer" "_on" elay "")
(setvar "CMDECHO" oldvar)
(setq nCount (1- nCount))
)
);end progn
);end if
(princ)
)
(defun c:g (/ ss oldvar)
(setq oldvar (getvar "CMDECHO"))
(while (setq ss (ssget))
(setvar "CMDECHO" 0)
(command "_.change" ss "" "_p" "_t" PAUSE "")
(setvar "CMDECHO" oldvar)
)
(setvar "CMDECHO" oldvar)
(princ)
)
;;=========================================================================
(defun _@ld (file)
(if (and
(not (member file _tchatoml))
(load (strcat _prefix file))
)
(setq _tchatoml (cons file _tchatoml))
)
(princ)
)
(defun c:clean ()
(setq _tchatoml nil)
)
(defun getpfx (/ str str1 i j n)
(setq str (getvar "acadprefix")
str1 (strcase str)
n (strlen str)
i 3
j 1
)
(while (and
(/= "\\SYS1;" (substr str1 i 6))
(> n i)
)
(setq i (1+ i))
)
(if (> n i)
(setq _prefix1 (strcat (substr str 1 (+ i 4)) "\\")
j (+ i 6)
i (+ j 6)
)
(setq i 6)
)
(while (and
(/= "\\SYS;" (substr str1 i 5))
(> n i)
)
(setq i (1+ i))
)
(strcat (substr str j (- i j)) "\\")
)
(defun angtos1 (a)
(angtos a (getvar "aunits") 9)
)
(defun redraw_le ()
(foreach e le_drw
(redraw e 4)
)
(foreach e le_del
(entdel e)
)
(setq le_drw nil
le_del nil
)
)
(defun *error* (msg)
(redraw_le)
(setvar "cmdecho" 0)
(setvar "users1" ".")
(slb_sld)
(mkstr2)
)
(defun s::startup ()
(if (not (menugroup "tch"))
(command "menu" "tch.mnu")
)
(princ "\n≡ TArch6 for R15 ≡")
(princ)
)
(setq _prefix0 (getpfx)
_prefix (strcat _prefix0 "LISP\\")
_dim_auto T
_is_v14 T
_pi2 (/ pi 2)
)
(if (not _prefix1)
(setq _prefix1 _prefix)
)
(setvar "cmdecho" 0)
(_@ld "loadcfg")
(loadcfg)
(setq t_blip (nth 4 _cfgdata))
(setvar "blipmode" (if t_blip
0
1
)
)
(setvar "limcheck" 0)
找朋友传的个lisp程序
在天正3里加载很好,在天正6里边加载的话,每打开一个图形都要重新加载一次,有没有高手能够指点下,能不能让他在天正6里不需要每次都加载 |
|