自编非常实用的AutoLisp程序招聘(广告)初来乍到,向各位奉上本人自编的一些实用的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) 
)