AutoLisp入门基础教程(3)

这是AutoLisp入门教程的第三部分，在教程的第二部分，我们编写了一个绘制瓦楞板多段线的小程序。这个Autolisp小程序涉及了一些重要常见的函数，例如 polar ， repeat 和 while 等（其语法和返回值可以参考： 常见函数1 ， 常见函数2 ， 常见函数3 ）。

再来回忆一下我们使用这个程序的时候是如何 *** 作的：1）加载这个程序，并输入 wlb 调用这个程序；2）按照提示选取起始点，然后选取终点，屏幕上画出一条多段线；3）继续拾取起始点和终点，再次划出一条多段线线；4）若想终止程序，按 ESC 或 Enter 即可。

也许你已经想到了，这个程序的 *** 作能不能改成这个样子：选取一条直线，根据这个直线的两个端点，自动生产一条多段线。这样就涉及了对AutoCAD对象属性的读取。

重点来了！！！

在入门教程的第三部分，我们将使用AutoLisp中相关函数对AutoCAD对象的属性进行选择、获取、修改和更新。常用的对象属性函数如下表：

对AutoCAD对象属性的修改实际上就是对AutoCAD对象属性列表的修改。

获得对象联合属性列表

编写一个chgrad.lsp程序，用来修改半径。

在原来的基础上画一个瓦楞板程序，要求选择一条线段，以此为轴线画一个瓦楞板。

平行四边形

(defun

C:pxsb

()

(setvar

"cmdecho"

0)

(setq

pt1

(getpoint

"\n请输入平行四边形起点:"))

(setq

s1

(getdist

pt1

"\平行四边形一个边长："))

(setq

s2

(getdist

pt1

"\平行四边形另一个边长："))

(setq

w

(getangle

"\平行四边形宽夹角："))

(setq

pt2

(polar

pt1

0

s1))

(setq

pt3

(polar

pt2

w

s2))

(setq

pt4

(polar

pt1

w

s2))

(command

"pline"

pt1

pt2

pt3

pt4

"c")

(setvar

"cmdecho"

1)

(princ)

)

同心圆

(defun

C:txy

()

(setvar

"cmdecho"

0)

(setq

cen

(getpoint

"\n请输入同心圆圆心:"))

(setq

d1

(getdist

pt1

"\n输入第一个圆的直径:"))

(setq

d2

(getdist

pt1

"\n输入第二个圆的直径:"))

(setq

d3

(getdist

pt1

"\n输入第三个圆的直径:"))

(command

"circle"

cen

"d"

d1)

(command

"circle"

cen

"d"

d2)

(command

"circle"

cen

"d"

d3)

(setvar

"cmdecho"

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)

)

---