自编非常实用的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) ) |