ThisDrawing.Utility.GetEntity getobj, po, \请选择移动对象\p0 = ThisDrawing.Utility.GetPoint(, \起点:\p1 = ThisDrawing.Utility.GetPoint(p0, \终点:\pe = p0 pc = p0 motimes = 3000

movx = (p1(0) - p0(0)) / motimes movy = (p1(1) - p0(1)) / motimes

For i = 1 To motimes pe(0) = pc(0) + movx pe(1) = pc(1) + movy getobj.Move pc, pe '移动一段 getobj.Update '更新对象 Next End Sub

先让用户选择移动的对象、起点、终点，motimes动画是设置动画帧数，这个例程是让对象移动3000小段，movx和movy是每一段移动的距离，然后进行一个3000次的循环，每一次循环移动一小段距离。 看第二个例题：做一个小轮子在一条山坡上运动的动画，山坡为正弦曲线。请注意，应该用偏移法获得轮圆心的轨迹才是正确的。编程思路：先画好圆和横轴，然后画山坡，偏移获得移动轨迹线，放到隐藏图层中，然后根据轨迹线移动圆和轴，在移动之前先旋转轴线。 旋转方法：object. rotate 基点,角度 偏移方法： object.offset(偏移量) Sub moveball()

Dim ccball As Variant '圆 Dim ccline As Variant '圆轴

Dim cclinep1(0 To 2) As Double '圆轴端点1 Dim cclinep2(0 To 2) As Double '圆轴端点2 Dim cc(0 To 2) As Double '圆心 Dim hill As Variant '山坡线

Dim moveline As Variant '移动轨迹线 Dim lay1 As AcadLayer '放轨迹线的隐藏图层 Dim vpoints As Variant '轨迹点

Dim movep(0 To 2) As Double '移动目标点坐标 cclinep1(0) = -0.1: cclinep2(0) = 0.1 '定义圆轴坐标

Set ccline = ThisDrawing.ModelSpace.AddLine(cclinep1, cclinep2) '画直线 Set ccball = ThisDrawing.ModelSpace.AddCircle(cc, 0.1) '画半径为0.1的圆

Dim p(0 To 719) As Double '申明正弦线顶点坐标 For i = 0 To 718 Step 2 '开始画多段线 p(i) = i * 3.1415926535897 / 360 '横坐标 p(i + 1) = Sin(p(i)) '纵坐标

Next i

Set hill = ThisDrawing.ModelSpace.AddLightWeightPolyline(p) '画正弦线即山坡曲线 hill.Update '显示山坡线

moveline = hill.Offset(-0.1) '球心运动轨迹线 vpoints = moveline(0).Coordinates '获得规迹点

Set lay1 = ThisDrawing.Layers.Add(\创建名为\的图层 lay1.LayerOn = False '关闭图层

moveline(0).Layer = \将轨迹线放到关闭的图层中 ZoomExtents '显示整个图形

For i = 0 To UBound(vpoints) - 1 Step 2 movep(0) = vpoints(i) '计算移动的轨迹 movep(1) = vpoints(i + 1) ccline.Rotate cc, 0.05 '旋转直线 ccline.Move cc, movep '移动直线 ccball.Move cc, movep '移动圆

cc(0) = movep(0) '把当前位置作为下次移动的起点 cc(1) = movep(1)

For j = 1 To 50000 '这次循环的目的是让小球移动得慢一点,循环量应根据自已的电脑速度设置 j = j * 1 Next j

ccline.Update '更新 Next i End Sub

本课结束，请做思考题：在一条直线上画两个同样大小的圆，然后让这两个圆沿直线相向而行，到互换位置后停下来，尺寸自定 回复

11楼2006-10-21 10:32回复11楼

flapsesame 老马

next--第十二课:参数化设计基础

简单地讲，参数化设计就是根据参数进行精确绘图，绘图所需要的参数也可以由用户手工输入。真正的参数化设计往往需要数据库操作，为了简化程序，把数据库部分放在以后的课程中详细讲解。 本课的例程是画一个标准足球场。足球场长度90～120米，宽度45～90米，而红色标注的尺寸是程序默认的，绿色标注固定不变。

Sub court()

Dim courtlay As AcadLayer '定义球场图层 Dim ent As AcadEntity '镜像对象

Dim linep1(0 To 2) As Double '线条端点1 Dim linep2(0 To 2) As Double '线条端点2 Dim linep3(0 To 2) As Double '罚球弧端点1 Dim linep4(0 To 2) As Double '罚球弧端点2 Dim centerp As Variant '中心坐标 xjq = 11000 '小禁区尺寸 djq = 33000 '大禁区尺寸 fqd = 11000 '罚球点位置 fqr = 9150 '罚球弧半径 fqh = 14634.98 '罚球弧弦长 jqqr = 1000 '角球区半径 zqr = 9150 '中圈半径 On Error Resume Next

chang = ThisDrawing.Utility.GetReal(\长度(90000～120000)<105000>\If Err.Number <> 0 Then '用户输入的不是有效数字 chang = 105000 Err.Clear '清除错误 End If

kuan = ThisDrawing.Utility.GetReal(\宽度(45000～90000)<68000>\If Err.Number <> 0 Then kuan = 68000 End If

centerp = ThisDrawing.Utility.GetPoint(, \定位球场中心:\Set courtlay = ThisDrawing.Layers.Add(\足球场\设置图层 ThisDrawing.ActiveLayer = courtlay '把当前图层设为足球场图层 '画小禁区

linep1(0) = centerp(0) + chang / 2 linep1(1) = centerp(1) + xjq / 2

linep2(0) = centerp(0) + chang / 2 - xjq / 2 linep2(1) = centerp(1) - xjq / 2

Call drawbox(linep1, linep2) '调用画矩形子程序 '画大禁区

linep1(0) = centerp(0) + chang / 2 linep1(1) = centerp(1) + djq / 2

linep2(0) = centerp(0) + chang / 2 - djq / 2 linep2(1) = centerp(1) - djq / 2 Call drawbox(linep1, linep2)

' 画罚球点

linep1(0) = centerp(0) + chang / 2 - fqd linep1(1) = centerp(1)

Call ThisDrawing.ModelSpace.AddPoint(linep1) 'ThisDrawing.SetVariable \点样式 ThisDrawing.SetVariable \点的尺寸 '画罚球弧，罚球弧圆心就是罚球点linep1 linep3(0) = centerp(0) + chang / 2 - djq / 2 linep3(1) = centerp(1) + fqh / 2

linep4(0) = linep3(0) '两个端点的x轴相同 linep4(1) = centerp(1) - fqh / 2

ang1 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep3) '计算角度 ang2 = ThisDrawing.Utility.AngleFromXAxis(linep1, linep4) Call ThisDrawing.ModelSpace.AddArc(linep1, zqr, ang1, ang2) '画弧 '角球弧

ang1 = ThisDrawing.Utility.AngleToReal(90, 0) '角度转换为弧度 ang2 = ThisDrawing.Utility.AngleToReal(180, 0) linep1(0) = centerp(0) + chang / 2 '角球弧圆心 linep1(1) = centerp(1) - kuan / 2

Call ThisDrawing.ModelSpace.AddArc(linep1, jqqr, ang1, ang2) '画弧 ang1 = ThisDrawing.Utility.AngleToReal(270, 0) linep1(1) = centerp(1) + kuan / 2

Call ThisDrawing.ModelSpace.AddArc(linep1, jqqr, ang2, ang1) '镜像轴

linep1(0) = centerp(0)

linep1(1) = centerp(1) - kuan / 2 linep2(0) = centerp(0)

linep2(1) = centerp(1) + kuan / 2 '镜像

For Each ent In ThisDrawing.ModelSpace '所有模型空间的对象进行一次循环 If ent.Layer = \足球场\对象在\足球场\图层中 ent.Mirror linep1, linep2 '镜像 End If Next ent '画中线

Call ThisDrawing.ModelSpace.AddLine(linep1, linep2) '画中圈

Call ThisDrawing.ModelSpace.AddCircle(centerp, zqr) '画外框

linep1(0) = centerp(0) - chang / 2 linep1(1) = centerp(1) - kuan / 2 linep2(0) = centerp(0) + chang / 2