将自已编写的lisp文件自动加载的方法
anion
anion Lv.2
2007年04月09日 18:29:04
只看楼主

对于CAD个人推荐使用2004版本,对于还在使用r14的朋友建议彻底放弃使用它,相对于2004版本,其破解简单完美,对计算机硬件要求不高。 一、很多用户在使用自己编写的lisp命令时,每次启动CAD都进行加载,影响了效率,下面介绍的方法可以解决这一问题。 1:首先找到acad.mnl文件,系统默认安装在Application Data\Autodesk\AutoCAD 200i\Support,当然你可将此文件移到你的CAD目录下

对于CAD个人推荐使用2004版本,对于还在使用r14的朋友建议彻底放弃使用它,相对于2004版本,其破解简单完美,对计算机硬件要求不高。
一、很多用户在使用自己编写的lisp命令时,每次启动CAD都进行加载,影响了效率,下面介绍的方法可以解决这一问题。
1:首先找到acad.mnl文件,系统默认安装在Application Data\Autodesk\AutoCAD 200i\Support,当然你可将此文件移到你的CAD目录下
2:请将你自己编写的AAA.lsp文件拷入ACAD的Support目录下,如果路径有指到你的目录也可以不用拷入。添加以下文本到acad.mnl。
(if(null C:XXX)(load"AAA")(princ));加载并执行你自己编写的AAA.lsp之XXX命令。

二、自动加载自己编写的菜单:添加以下文镜絘cad.mnl
(if(null (menugroup "你的工具條"))(command "menuload" "BBB")(princ));加载你的工具条菜单BBB.mnu之"你的工具條"

三、以下一点小程序给大家:

;本程序改变字体对齐方式为左齐,字宽比例,字高
(defun C:cht(/ s1 ename ti% p11 p10 f en p11n p10n fj fj1 fw fw1 fwtmp fh fh1 fhtmp)
(setq fw (getreal "\n*** 共享程序 by anion *** 修改文字左齐, 请输入字宽比例 <0.7>:")) (if (null fw)(setq fw 0.7));默认0.7
(setq fh (getreal "\n 请输入字高<保持不变>:"));默认字高保持不变
(setq
s1
(ssget ’((0 . "TEXT")))
)

(setq ti% 0)
(if (/= s1 nil)
(progn
(while
(<=
ti%
(- (sslength s1) 1)
)
(setq ename(ssname s1 ti%))
(setq p11 nil) ;将p11置空
(setq e (entget ename)) ;取实体表e
(setq p11 (assoc 11 e)) ;取对齐点
(setq p10 (assoc 10 e)) ;取其始点表
(setq f (assoc 10 e)) ;如上
(setq en e)
(if (= (cdr f) 0) (setq p11n (cons 11 (cdr p10))))

(if (/= (cdr f ) 0)
(progn
(setq p10n (cons 10 (cdr p11)));将对齐点位构成其始点表赋给p10n
(setq en (subst p10n p10 en)) ;用新的其始点位更换旧的其始 点表
)
)

;属性修改,在这里你可以修改你需要的字体属性
(setq fj 0) ;对齐方式
(setq fj (cons 72 fj)) ;(72 . 0) 为左齐
(setq fj1 (assoc 72 en)) ;取旧的对齐方式
(setq e (subst fj fj1 e)) ;更换旧的对齐方式为左齐

(setq fwtmp fw) ;字宽比例
(setq fwtmp (cons 41 fwtmp)) ;(41 . 0.7) 字宽比例
(setq fw1 (assoc 41 en)) ;取旧的字宽比例
(setq e (subst fwtmp fw1 e)) ;更换旧的字宽比例

(if (/= fh nil)
(progn
(setq fhtmp fh)
(setq fhtmp (cons 40 fhtmp)) ;(40 . 300) 字高
(setq fh1 (assoc 40 en)) ;取旧的字高
(setq e (subst fhtmp fh1 e)) ;更换旧的字高
))

(entmod e)
;属性修改结束

(setq ti%(+ 1 ti%))
) ;end while
) ;endprogn s1/=nil
) ;endif s1 /= nil
(setq s1 nil)
(setq fw nil)
(setq fh nil)
(princ)
)
;

免费打赏
anion
2007年04月09日 18:29:16
2楼
;本程序改变线宽
(defun C:chw (/ s e el n co pw)
(setvar "cmdecho" 0)(gc)
(setq pw (getreal "\n[*** 共享程序 by anion *** Please input new width] <40>:"));默认40
(if (null pw)(setq pw 40))
(setq s (ssget))
(while (and s (setq e (ssname s 0)))
(setq el (entget e) s (ssdel e s))
(setq n (cdr(assoc 0 el)) co (cdr(assoc 62 el)) la (cdr(assoc 8 el)))
(if (= n "LINE")(command "pedit" e "y" "w" pw ""))
(if (or (= n "POLYLINE")(= n "LWPOLYLINE"))(command "pedit" e "w" pw ""))
(if (= n "ARC")(command "pedit" e "y" "w" pw ""))
(if (= n "CIRCLE")
(progn
(setq pc (cdr(assoc 10 el)) rad (cdr(assoc 40 el)))
(entdel e)
(setq rad-out (* 2 rad) rad-in (* 2 (- rad pw)))
(command "color" co)
(command "layer" "m" la "")
(command "donut" rad-in rad-out pc "")
)
)
(gc)
)
(setvar "cmdecho" 1)
(princ)
)
;

;连续复制
(defun C:cc (/ s)
(setvar "cmdecho" 0)(gc)
(setq s (ssget))
(if (/= s nil)(command "_copy" s "" "m"))
(gc)(setvar "cmdecho" 1)
(setq s nil)
(princ)
)


;恢复鼠标中键移动
(defun C:mm ()(command "_mbuttonpan" "1")(gc)(princ) )


(defun C:gen(/ ENT I LENG SSET) ;;;;;;;减少用regen命令的时间
(princ "\n请选择重画对象")
(setq sset (ssget) leng (sslength sset))
(setq i 0)
(while (< i leng)
(setq ent (ssname sset i))
(entmod (entget ent))
(setq i (+ i 1))
(princ))
)
;


回复
hgm78
2008年08月11日 17:24:57
3楼
好东西,楼主,感谢感谢!!
回复
hgm78
2008年08月11日 17:25:52
4楼
多送几支花,赞 :call: :call: :call: :call: :call:
回复
lsj1234wy
2008年08月24日 13:09:25
5楼
感谢感谢感谢感谢感谢感谢
回复
天马
2008年08月25日 10:33:13
6楼
非常感谢楼主的杰作!
同时也感谢网易给了我们这样好的交流平台!
还有辛勤的斑竹。
正是因为有了楼主这样好的“人人为我,我为人人”的精神,才使网络更加美丽。
回复
ku-8510
2008年09月10日 12:41:37
7楼
谢谢,楼主你太有才了:victory:
回复
xushengfa
2008年09月12日 08:19:13
8楼
楼主的《将自已编写的lisp文件自动加载的方法》很有价值,感谢楼主的无私奉献!!
回复
wanglin-741
2008年09月24日 22:24:56
9楼
好东西,楼主:lol
回复
会飞房子
2008年10月25日 12:19:16
10楼
:victory: :time:
回复
会飞房子
2008年10月25日 12:25:48
11楼
:handshake :victory: :)
回复

相关推荐

APP内打开