[ 本帖最后由 红岩霸王 于 2006-10-29 13:16 编辑 ] 不错,我做了这么长时间CAD,第一次见到这么好的教程.谢谢,版主.
就是看不懂.版主,有没有视频教程.
有的话.能传上来吗,
小弟,在此先谢谢了哟, 太好了,我也一直在寻找相关内容. I LIKE THIS TEACH METHOD, THANK YOU FOR SHARE. Autocad VBA初级教程 (第九课:创建选择集)
1.在创建对象的同时可以直接引用.以前的例程中已经做过多次了,现在复习一下,看例程:先随机画300个圆,在画圆时直接引用,然后再把这些圆根本大小修改颜色.
Sub c300()
Dim myselect(0 To 300) As AcadEntity '定义选择集数组
Dim pp(0 To 2) As Double '圆心坐标
For i = 0 To 300 '循环300次
pp(0) = 3000 * Rnd: pp(1) = 3000 * Rnd: pp(2) = 0 '设置圆心坐标
Set myselect(i) = ThisDrawing.ModelSpace.AddCircle(pp, Rnd * 30 + 1) '画不同大小的圆
Next i
For i = 1 To 300
If myselect(i).Radius > 10 Then '判断圆的直径是否大于10
myselect(i).color = Int(255 * Rnd + 1) '大圆颜色改为随机数
Else
myselect(i).color = 0 '小圆改为白色
End If
Next i
ZoomExtents '缩放到显示全部对象
End Sub
pp(0) = 3000 * Rnd: pp(1) = 3000 * Rnd: pp(2) = 0
这一行实际上应该是三条语句,用三行合并为一行,用冒号分开
rnd是随机数函数,它的数值为0-1之间的小数,3000*rnd得到的数值就是在0-3000之间的随机数
Set myselect(i) = ThisDrawing.ModelSpace.AddCircle(pp, Rnd * 30 + 1)
这条语句的作用是以pp点坐标为圆心,画一个圆,半径是1-30之间的随机数,赋值给myselect选择集.
2.提标用户在屏幕中选取
选择语句这样写:Set sset = ThisDrawing.SelectionSets.Add("ss1"),其中”ss1”是一个选择集名称,这个参数可以随意写一个,注意不要重复就可以了.
下面的例程是让用户选择对象,然后把选中的对象改为绿色,最后把选择集删除
Sub mysel()
Dim sset As AcadSelectionSet '定义选择集对象
Dim element As AcadEntity '定义选择集中的元素对象
Set sset = ThisDrawing.SelectionSets.Add("ss1") '新建一个选择集
sset.SelectOnScreen '提示用户选择
For Each element In sset '在选择集中进行循环
element.color = acGreen '改为绿色
Next
sset.Delete '删除选择集
End Sub
3.选择全部对象
用select方法,参数为acSelectionSetAll ,看例程,这个程序选择全部对象,显示选中的对象,并计算对象数.
Sub allsel()
Dim sel1 As AcadSelectionSet '定义选择集对象
Set sel1 = ThisDrawing.SelectionSets.Add("s") '新建一个选择集
Call sel1.Select(acSelectionSetAll) '全部选中
sel1.Highlight (True) '显示选择的对象
sco= sel1.Count '计算选择集中的对象数
MsgBox "选中对象数:" & CStr(sco) '显示对话框
End Sub
3.运用select方法
上面的例题已经运用了select方法,下面讲一下select的5种选择方式:
1:择全部对象(acselectionsetall)
2.选择上次创建的对象(acselectionsetlast)
3.选择上次选择的对象(acselectionsetprevious)
4.选择矩形窗口内对象(acselectionsetwindow)
5.选择矩形窗口内以及与边界相交的对象(acselectionsetcrossing)
还是看代码来学习.其中选择语句是:
Call sel1.Select(Mode, p1, p2)
Mode已经定义为5,也就是选择矩形窗口内以及与边界相交的对象,p1和p2是两个点坐标,
Sub selnew()
Dim sel1 As AcadSelectionSet '定义选择集对象
Dim p1(0 To 2) As Double '坐标1
Dim p2(0 To 2) As Double '坐标2
p1(0) = 0: p1(1) = 0: p1(2) = 0 '设置坐标1
p2(0) = 300: p2(1) = 300: p2(2) = 0 '设置坐标1
Mode = 5 '把选择模式存入mode变量中
Set sel1 = ThisDrawing.SelectionSets.Add("sel3") '新建一个选择集
Call sel1.Select(Mode, p1, p2) '选择对象
sel1.Highlight (ture) '显示已选中的对象
End Sub Autocad VBA初级教程 (第十课:画多段线和样条线)
画二维多段线语句这样写：
set lobj= ThisDrawing.ModelSpace.AddLightweightPolyline(fitpoint)
AddLightweightPolyline后面需一个参数，存放顶点坐标的数组
画三维多段线语句这样写：
Set lobj = ThisDrawing.ModelSpace.Add3DPoly(fitpoint)
Add3dpoly后面需一个参数，就是顶点坐标数组
画二维样条线语句这样写：
Set lobj = ThisDrawing.ModelSpace.AddSpline(fitPoints,startT, endT)
Addspline后需要三个参数，第一个是拟合点数组，后面两个分别是起点切向和终点切向。
下面看例题。这个程序是第三课例程的改进版。原题是这样的：
绘制三维多段线时X、Y值在屏幕上用鼠标选取，Z值用键盘输入。
细心的读者是否还记得这个小程序已经在第三课的回贴中发布了。先分析一下编程细路：
用动态数组存放多段线的所有顶点坐标，获得新坐标后就把前一次画的多段线删除，画出多段线，并将线段第二点的端点保存为下一条线段的第一个端点坐标，以下是源码：
Sub myl()
Dim p1 As Variant '申明端点坐标
Dim p2 As Variant
Dim l() As Double '声明一个动态数组
Dim templ As Object
p1 = ThisDrawing.Utility.GetPoint(, "输入点:") '获取点坐标
z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
p1(2) = z '将Z坐标值赋予点坐标中
ReDim l(0 To 2) '定义动态数组
l(0) = p1(0)
l(1) = p1(1)
l(2) = z
On Error GoTo Err_Control '出错陷井
Do '开始循环
p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标
z = ThisDrawing.Utility.GetReal("Z坐标:") '用户输入Z坐标值
p2(2) = z '将Z坐标值赋予点坐标中
lub = UBound(l) '获取当前l数组中元的元素个数
ReDim Preserve l(lub + 3)
For i = 1 To 3
l(lub + i) = p2(i - 1)
Next i
If lub > 3 Then
templ.Delete '删除前一次画的多段线
End If
Set templ = ThisDrawing.ModelSpace.Add3DPoly(l) '画多段线
p1 = p2 '将第二点的端点保存为下一条直线的第一个端点坐标
Loop
Err_Control:
End Sub
我们学一学动态数组，这是非常有用的。所谓动态数组，简单讲就是数组元素可以改变的特殊数组。
这样定义数组：Dim l( ) As Double
赋值语句：
ReDim l(0 To 2)
l(0) = p1(0)
l(1) = p1(1)
l(2) = z
重新定义数组元素语句：
lub = UBound(l) '先要获取当前l数组中元的元素个数,用ubount函数计算。
ReDim Preserve l(lub + 3)
重定义时数组中要加三个元素，用以存放坐标值，所以定义元素为lub+3。给数值赋值的语句是一样的。
再看画多段线语句：
Set templ = ThisDrawing.ModelSpace.Add3DPoly(l) '画多段线
在最后面括号中的l就是存放点坐标的动态数组，这条语句在画多段线的同时把多段线作为对象赋值给templ 变量，这样下面的删除语句就可以直接引用这个变量了。
删除语句：
templ.Delete
因为已经知道对象是templ，所以只要在对象后面用delete方法就可以了。
下面的例程更加实用些，它的功能是把样条线转化为多段线。编程思路：用户选择一根样条线，计算样条线的拟合点，然后把所有的拟合点存放到数组中，最后用这个数组画多段线。
Sub sp2pl()
Dim getsp As Object ‘获取样条线的变量
Dim newl() As Double ‘多段线数组
Dim p1 As Variant ‘获得拟合点点坐标
ThisDrawing.Utility.GetEntity getsp, po, "本程序将样条曲线转为多段线。请选择样条曲线"
sumctrl = getsp.NumberOfControlPoints ‘计算样条线中一共有多少拟合点
ReDim newl(0 To sumctrl * 3 - 1) ‘重定义数组
For i = 0 To sumctrl - 1 ‘开始循环，
p1 = getsp.GetControlPoint(i) ‘把拟合点坐标存到p1变量中
For j = 0 To 2
newl(i * 3 + j) = p1(j)
Next j
Next i
Set templ = ThisDrawing.ModelSpace.Add3DPoly(newl) ‘画样条线
End Sub
下面的语句是让用户选择样条线：
ThisDrawing.Utility.GetEntity getsp, po, "本程序将样条曲线转为多段线。请选择样条曲线"
ThisDrawing.Utility.GetEntity 后面需要三个参数：
第一个getsp用于存放获得用户选择的对象变量，第二个po是用户鼠标点下时的位置，第三个是一段字符串，显示在提示栏。 Autocad VBA初级教程 (第十一课:动画基础)
说实话，用ACAD玩动画绝对比不上专业的三维动画软件，不过这年头自称精通CAD的工程师太多了，而学会用ACAD玩动画一定能提高您的竞争实力， 想象一下您用ACAD动画向老板演示零件的装配方法……
下面的例题是一个最简单的动画，由用户选择一个要移动的对象，然后定位起点和终点，程序会慢慢地把对象移动。
移动方法：object.move 起点坐标,端点坐标
Sub testmove()
Dim p0 As Variant '起点坐标
Dim p1 As Variant '终点坐标
Dim pc As Variant '移动时起点坐标
Dim pe As Variant '移动时终点坐标
Dim movx As Variant 'x轴增量
Dim movy As Variant 'y轴增量
Dim getobj As Object '移动对象
Dim movtimes As Integer '移动次数
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("hidelay") '创建名为"hidelay"的图层
lay1.LayerOn = False '关闭图层
moveline(0).Layer = "hidelay" '将轨迹线放到关闭的图层中
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
本课结束，请做思考题：在一条直线上画两个同样大小的圆，然后让这两个圆沿直线相向而行，到互换位置后停下来，尺寸自定 哇！
不你的鸭文件给我们分享一下啊 ，谢谢 太好了! 谢谢!
很不错呀!
谢了!:victory: 第五课思考题，我的代码：Sub sinl()
Dim p(0 To 600) As Double
Dim myl As Object
For i = -50 To 50step 0.2
j = i + 50
p(j) = i
p(j + 1) = 0.5 * p(j) * p(j) + 3
Next i
Set myl = ThisDrawing.ModelSpace.AddLightWeightPolyline(p)
ZoomExtents
End Sub
可是，老是提示：安全数组中的元素太少或者总元素数目不是3的倍数。
请问这是真么错误。
回复 #41 piteqiu 的帖子
问个弱智点的问题，这东西只有basic语言支持么？没有c或者java支持？实在是懒得记住太多语言... 您好!请问有VBA函数字典吗?谢谢! 你好!楼主,请问下面还有课程吗?另有一个问题请教:在抛物线程序内,将step后的参数改为4或更大时,为什么显示不对呢?
谢谢!!! 非常感谢