求一个简单的AutoLISP程序实例

Question

比如将CAD中画直线的快捷键“L”改为“XX”

Answer 1

初来乍到，向各位奉上本人自编的一些实用的AutoLisp程序，希望对大家有用。
其中命令包括：
c:/ ；格式刷
c:0 ；自定义坐标系
c:00 ；世界坐标系
c:csh ；图层及标注样式初始化
c:cx ；x方向复制
c:cy ；y方向复制
c:j ；水平标注
c:k ；绘制圆引线序号球
c:kk ；绘制方引线序号球
c:kkk ；绘制连续序号球
c:kkkk ；填充连续序号
c:lf ; 关闭选中对象图层
c:lg ; 关闭选中对象图层外的其他图层
c:ln ; 设置选中对象图层为当前图层
c:mx ；x方向移动
c:my ；y方向移动

以下是程序，欢迎大家指正：

;;; 图层管理程序==》

(defun c:csh () ; 初始化图层和标注样式
(setvar 'cmdecho 0)
(sztc1)
(szbz1)
(setvar 'cmdecho 1)
)

(defun c:ln () ; 设置选中对象图层为当前图层
(setq e1 (entget (car (entsel "\n选择一个对象："))))
; (entget (entlast))
(setq layer1 (assoc 8 e1))
(setq layername (cdr layer1))
(command "-layer" "s" layername "")
(prin1 layername)
)

(defun c:lf () ; 关闭选中对象图层
(setq e1 (entget (car (entsel "\n选择一个对象："))))
; (entget (entlast))
(setq layer1 (assoc 8 e1))
(setq layername (cdr layer1))
(command "-layer" "off" layername "")
(princ)
)

(defun c:lg () ; 关闭选中对象图层外的其他图层
(setq e1 (entget (car (entsel "\n选择一个对象，其余图层将被关闭："))))
;
(setq layer1 (assoc 8 e1))
(setq layername (cdr layer1))
(command "-layer" "off" "*" "y" "on" layername "s" layername "")
(princ)
)

;;; 《==图层管理程序

;;; 作图/标注程序==》

(defun c:a3 () ; 插入a3图框
(setq p1 (getpoint "\n放置点："))
(command
"-insert"
"*C:\\Program Files\\AutoCAD 2007\\Support\\A3.dwg"
p1 ""
""
)
(princ)
)

(defun c:a4 () ; 插入a4图框
(setq p1 (getpoint "\n放置点："))
(command
"-insert"
"*C:\\Program Files\\AutoCAD 2007\\Support\\A4.dwg"
p1 ""
""
)
(princ)
)

(defun c:00 () ; 自定义坐标
(command "ucs")
(princ)
)

(defun c:0 () ; 设置系统坐标
(command "ucs" "")
(princ)
)

(defun c:/ () ; 格式刷
(command "'_matchprop")
(princ)
)

(defun c:j () ; 直线标注
(command "-layer" "s" "6标注" "")
(command "_dimlinear")
(princ)
)

(defun c:jj () ; 圆或圆弧标注
(command "-layer" "s" "6标注" "")
(setq e1 (entget (car (entsel "选择圆或圆弧："))))
(if (= (cdr (assoc 0 e1)) "ARC")
(command "_dimradius")
(command "_dimdiameter")
)
(princ)
)

;;; 序号球==》

(defun drawline (pt1 zh)
(if (= zh "h")
(progn (command "rectang"
(list (+ (car pt1) 8) (cadr pt1) (caddr pt1))
"@8,8"
)
(command "-array" "last" "" "r" "1" "10" "8")
)
(progn (command "rectang"
(list (car pt1) (- (cadr pt1) 8) (caddr pt1))
"@8,-8"
)
(command "-array" "last" "" "r" "10" "1" "-8")
)
)
)

(defun deleteline (pt1 zh)
(if (= zh "h")
(ssget "_w"
pt1
(list (+ (car pt1) 88) (+ (cadr pt1) 8) (caddr pt1))
'((0 . "LWPOLYLINE"))
)
(ssget "_w"
pt1
(list (+ (car pt1) 8) (- (cadr pt1) 88) (caddr pt1))
'((0 . "LWPOLYLINE"))
)
)
(command "erase" "p" "")
)

(defun c:k () ; 画引线序号球
(command "-layer" "s" "6标注" "")
(setq old_os (getvar 'osmode))
(setq zh (getstring "\n横向<h>?纵向<z>? <h>："))
(if (= zh "")
(setq zh "h")
)
(setq p1 (getpoint "\n基点："))
(setq p2 (getpoint "\n第二点："))
(setq pt1 p2)
(drawline pt1 zh)
(while p1
(setq s (getstring "\n输入注释文字："))
(setq dis (distance p1 p2))
(setq ang (angle p1 p2))
(setq p3 (polar p1 ang (- dis 3.5)))
(setvar 'osmode 0)
(command "line" p1 p3 "")
(command "circle" p2 "3.5")
(setq th (getvar 'dimtxt))
(command "text" "j" "mc" p2 th "" s "")
(setvar 'osmode old_os)
(setq p1 (getpoint "\n基点："))
(if (= p1 nil)
(progn
(deleteline pt1 zh)
(princ
"\n命令<k>画圆引线序号球 <kk>画方引线序号球 <kkk>画序号球 <kkkk>填写序号"
)
(exit)
(princ)
)
)
(setq p2 (getpoint "\n第二点："))
)
)

(defun c:kk () ; 画方引线序号球
(command "-layer" "s" "6标注" "")
(setq old_os (getvar 'osmode))
(setq zh (getstring "\n横向<h>?纵向<z>? <h>："))
(if (= zh "")
(setq zh "h")
)
(setq p1 (getpoint "\n基点："))
(setq p2 (getpoint "\n第二点："))
(setq pt1 p2)
(drawline pt1 zh)
(while p1
(setvar 'osmode 0)
(setq s (getstring "\n输入注释文字："))
(if (> (car p2) (car p1))
(if (> (cadr p2) (cadr p1))
(progn (setq p3 (list (- (car p2) 3.5) (- (cadr p2) 3.5) (caddr p2)))
(command "rectang" p3 "@7,7")
)
(progn (setq p3 (list (- (car p2) 3.5) (+ (cadr p2) 3.5) (caddr p2)))
(command "rectang" p3 "@7,-7")
)
)
(if (> (cadr p2) (cadr p1))
(progn (setq p3 (list (+ (car p2) 3.5) (- (cadr p2) 3.5) (caddr p2)))
(command "rectang" p3 "@-7,7")
)
(progn (setq p3 (list (+ (car p2) 3.5) (+ (cadr p2) 3.5) (caddr p2)))
(command "rectang" p3 "@-7,-7")
)
)
)
(command "line" p1 p3 "")
(setq th (getvar 'dimtxt))
(command "text" "j" "mc" p2 th "" s "")
(setvar 'osmode old_os)
(setq p1 (getpoint "\n基点："))
(if (= p1 nil)
(progn
(deleteline pt1 zh)
(princ
"\n命令<k>画圆引线序号球 <kk>画方引线序号球 <kkk>画序号球 <kkkk>填写序号"
)
(exit)
(princ)
)
(setq p2 (getpoint "\n第二点："))
)
)
)

(defun c:kkk () ; 画序号球
(command "-layer" "s" "6标注" "")
(setq old_os (getvar 'osmode))
(setq n (getint "\n设置起始值<1>"))
(if (= n nil)
(setq n 1)
)
(setvar 'osmode 32)
(setq p1 (getpoint "\n基点："))
(while p1
(setq p2 (list (- (car p1) 5) (- (cadr p1) 5) (caddr p1)))
(setvar 'osmode 0)
(command "circle" p2 "3.5")
(command "text" "j" "mc" p2 "" "" n "")
(setq n (1+ n))
(setvar 'osmode 32)
(setq p1 (getpoint "\n下一基点："))
)
(setvar 'osmode old_os)
(princ
"\n命令<k>画圆引线序号球 <kk>画方引线序号球 <kkk>画序号球 <kkkk>填写序号"
)
(princ)
)

(defun c:kkkk () ; 填写序号
(command "-layer" "s" "6标注" "")
(setq old_os (getvar 'osmode))
(setq n1 (getint "\n设置起始值<1>"))
(if (= n1 nil)
(setq n1 1)
)
(setq n2 (getint "\n设置结束值<10>"))
(if (= n2 nil)
(setq n2 10)
)
(setvar 'osmode 32)
(setq p1 (getpoint "\n基点："))
(setq p2 (getpoint "\n下一点："))
(setq p3 (list (/ (+ (car p1) (car p2)) 2)
(/ (+ (cadr p1) (cadr p2)) 2)
(caddr p1)
)
)
(setvar 'osmode 0)
(while (< n1 (1+ n2))
(command "text" "j" "mc" p3 "" "" n1 "")
(setq p3 (list (car p3)
(+ (cadr p3) (- (cadr p2) (cadr p1)))
(caddr p1)
)
)
(setq n1 (1+ n1))
)
(setvar 'osmode old_os)
(princ
"\n命令<k>画圆引线序号球 <kk>画方引线序号球 <kkk>画序号球 <kkkk>填写序号"
)
(princ)
)

;;; 《==作图/标注程序

;;; 移动复制程序==》

(defun c:mx ()
(setq ss (ssget))
(setq p1 (getpoint "\n基点："))
(setq p2 (getpoint "\n第二点："))
(setq p3 (list (car p2) (cadr p1) (caddr p1)))
(command "move" ss "" p1 p3)
(princ)
)

(defun c:my ()
(setq ss (ssget))
(setq p1 (getpoint "\n基点："))
(setq p2 (getpoint "\n第二点："))
(setq p3 (list (car p1) (cadr p2) (caddr p1)))
(command "move" ss "" p1 p3)
(princ)
)

(defun c:cx ()
(setq ss (ssget))
(setq p1 (getpoint "\n基点："))
(setq p2 (getpoint "\n第二点："))
(setq p3 (list (car p2) (cadr p1) (caddr p1)))
(command "copy" ss "" p1 p3)
(princ)
)

(defun c:cy ()
(setq ss (ssget))
(setq p1 (getpoint "\n基点："))
(setq p2 (getpoint "\n第二点："))
(setq p3 (list (car p1) (cadr p2) (caddr p1)))
(command "copy" ss "" p1 p3)
(princ)
)

;;; 《==移动复制程序

;;;以下为自定义函数：
;;;_____________________________________________________________________________
;;; ((setvar 'measurement 1))

(defun sztc1 () ; 自动设置图层函数==>>
(setq l1 "0"
l2 "1中心线"
l3 "2粗实线"
l4 "3细实线"
l5 "4剖面线"
l6 "5虚线"
l7 "6标注"
l8 "7轮廓线"
) ; 设置图层名称
(setq c1 33
c2 1
c3 7
c4 6
c5 2
c6 4
c7 40
c8 5
) ; 设置图层颜色
(setq lt1 "Continuous"
lt2 "CENTER2"
lt3 "Continuous"
lt4 "Continuous"
lt5 "Continuous"
lt6 "DASHED2"
lt7 "Continuous"
lt8 "Dividex2"
) ; 设置图层线形
(setq lw1 0.13
lw2 0.13
lw3 0.30
lw4 0.13
lw5 0.13
lw6 0.13
lw7 0.13
lw8 0.13
) ; 设置图层线宽
; (command "-linetype" "l" "center2"
; "")
; (command "-linetype" "l" "dashed2"
; "")
; (command "-linetype" "l"
; "acad_is005w100" "")
(command "-layer" "n" l1 "c" c1 l1 "l" lt1 l1 "lw" lw1 l1 "")
(command "-layer" "n" l2 "c" c2 l2 "l" lt2 l2 "lw" lw2 l2 "")
(command "-layer" "n" l3 "c" c3 l3 "l" lt3 l3 "lw" lw3 l3 "")
(command "-layer" "n" l4 "c" c4 l4 "l" lt4 l4 "lw" lw4 l4 "")
(command "-layer" "n" l5 "c" c5 l5 "l" lt5 l5 "lw" lw5 l5 "")
(command "-layer" "n" l6 "c" c6 l6 "l" lt6 l6 "lw" lw6 l6 "")
(command "-layer" "n" l7 "c" c7 l7 "l" lt7 l7 "lw" lw7 l7 "")
(command "-layer" "n" l8 "c" c8 l8 "l" lt8 l8 "lw" lw8 l8 "")
(princ "\n图层设置完毕!")
(princ)
)
;;; <<==自动设置图层函数

(defun szbz1 () ; 设置标注样式
(setvar 'dimadec 0) ; 角度小数位数
(setvar 'dimalt 0) ; 选定的换算单位
(setvar 'dimaltd 3) ; 换算单位小数位数
(setvar 'dimaltf 0.0394) ; 换算单位比例因子
(setvar 'dimaltrnd 0) ; 换算单位舍入值
(setvar 'dimalttd 3) ; 换算公差小数位数
(setvar 'dimalttz 0) ; 换算公差消零
(setvar 'dimaltu 2) ; 换算单位
(setvar 'dimaltz 0) ; 换算单位消零
(setvar 'dimapost "") ; 替换文字的前缀和后缀
(setvar 'dimarcsym 0) ; 弧长符号
(setvar 'dimasz 2.5) ; 箭头大小
(setvar 'dimatfit 3) ; 箭头和文字调整
(setvar 'dimaunit 0) ; 角度单位格式
(setvar 'dimazin 2) ; 角度消零
(setvar 'dimblk "") ; 箭头块名
(setvar 'dimblk1 "") ; 第一个箭头块名
(setvar 'dimblk2 "") ; 第二个箭头块名
(setvar 'dimcen 3) ; 圆心标记大小
(setvar 'dimclrd 0) ; 尺寸线和引线颜色
(setvar 'dimclre 0) ; 尺寸界线颜色
(setvar 'dimclrt 0) ; 标注文字颜色
(setvar 'dimdec 2) ; 小数位数
(setvar 'dimdle 0) ; 尺寸线
(setvar 'dimdli 3.75) ; 尺寸线间距
(setvar 'dimdsep ".") ; 小数分隔符
(setvar 'dimexe 1.25) ; 尺寸界线在尺寸线上
(setvar 'dimexo 0) ; 尺寸界线原点偏移
(setvar 'dimfrac 0) ; 分数格式
(setvar 'dimfxl 1) ; 固定的尺寸界线
(setvar 'dimfxlon 0) ; 启用固定的尺寸界线
(setvar 'dimgap 0.625) ; 尺寸线和文字的间距
; (setvar 'dimjogang 46)
; 半径标注折弯角度
(setvar 'dimjust 0) ; 尺寸线上的文字对正
(setvar 'dimldrblk "") ; 引线块名
(setvar 'dimlim 0) ; 生成标注界限
(setvar 'dimltex1 ".") ; 线型尺寸界线 1
(setvar 'dimltex2 ".") ; 线型尺寸界线 2
(setvar 'dimltype ".") ; 标注线型
(setvar 'dimlunit 2) ; 线性单位格式
(setvar 'dimlwd -2) ; 尺寸线和引线线宽
(setvar 'dimlwe -2) ; 尺寸界线线宽
(setvar 'dimpost "") ; 标注文字的前缀和后缀
(setvar 'dimrnd 0) ; 舍入值
(setvar 'dimsah 0) ; 独立的箭头块
(setvar 'dimscale 1) ; 全局比例因子
(setvar 'dimsd1 0) ; 隐藏第一条尺寸线
(setvar 'dimsd2 0) ; 隐藏第二条尺寸线
(setvar 'dimse1 0) ; 隐藏第一条尺寸界线
(setvar 'dimse2 0) ; 隐藏第二条尺寸界线
(setvar 'dimsoxd 0) ; 隐藏外侧尺寸线
(setvar 'dimtad 1) ; 文字位于尺寸线上方
(setvar 'dimtdec 2) ; 公差小数位数
(setvar 'dimtfac 1) ; 公差文字高度比例因子
(setvar 'dimtfill 0) ; 文字背景已启用
(setvar 'dimtfillclr 0) ; 文字背景颜色
(setvar 'dimtih 0) ; 尺寸界线内侧的文字水平放置
(setvar 'dimtix 0) ; 将文字放置于尺寸界线内侧
(setvar 'dimtm 0) ; 下偏差
(setvar 'dimtmove 0) ; 文字移动
(setvar 'dimtofl 1) ; 强制在尺寸界线内侧画尺寸线
(setvar 'dimtoh 1) ; 外侧文字水平放置
(setvar 'dimtol 0) ; 公差标注
(setvar 'dimtolj 0) ; 公差垂直对齐
(setvar 'dimtp 0) ; 上偏差
(setvar 'dimtsz 0) ; 标记大小
(setvar 'dimtvp 0) ; 文字垂直位置
(setvar 'dimtxt 3.5) ; 文字高度
(setvar 'dimtzin 8) ; 公差消零
(setvar 'dimupt 0) ; 用户定位的文字
(setvar 'dimzin 8) ; 消零
(command "-style" "1 长仿宋体" "gbeitc.shx,gbcbig.shx"
"" "0.7" "" ""
""
)
(setvar 'dimtxsty "1 长仿宋体") ; 标注文字样式
(setq n (getreal "\n尺寸比例?<1>"))
(if (= n nil)
(setvar 'dimlfac 1)
(setvar 'dimlfac n)
) ; 线性单位比例因子
(command "-dimstyle" "s" "1 长仿宋体标注")
(princ)
)

参考资料：http://www.jxcad.com.cn/read.php?tid=745607

Answer 2

工具，自定义，程序参数autocad.pgp文件打开后，把*L *LINE,把前面的L改为XX就行了，很简单。