scs5999 发表于 2008-1-24 11:25:00

利用VB写的随鼠标移动的图形

<p>Imports Autodesk.AutoCAD.Runtime<br/>Imports Autodesk.AutoCAD.ApplicationServices<br/>Imports Autodesk.AutoCAD.EditorInput<br/>Imports Autodesk.AutoCAD.Geometry<br/>Imports Autodesk.AutoCAD.Interop<br/>Imports Autodesk.AutoCAD.Interop.Common</p><p>Public Class Class1</p><p>&nbsp;&nbsp;&nbsp; &lt;CommandMethod("mtest")&gt; _<br/>&nbsp;&nbsp;&nbsp; Public Sub test()</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim sd As New MotionalMousePoint<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; AddHandler ed.PointFilter, AddressOf sd.GetMousePoint<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim pro As PromptPointOptions = New PromptPointOptions("请选择插入点...")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ed.GetPoint(pro)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; RemoveHandler ed.PointFilter, AddressOf sd.GetMousePoint</p><p>&nbsp;&nbsp;&nbsp; End Sub<br/>End Class</p><p>Public Class MotionalMousePoint</p><p>&nbsp;&nbsp;&nbsp; Private MousePoint As Point3d = New Point3d(0, 0, 0) '保存当前鼠标位置&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; ''动态获取鼠标位置&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Public Sub GetMousePoint(ByVal sender As Object, ByVal e As PointFilterEventArgs)</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MousePoint = e.Context.ComputedPoint<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim m_ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; DelegateTest(MousePoint, AddressOf ObjectMove2Mouse)</p><p>&nbsp;&nbsp;&nbsp; End Sub</p><p>&nbsp;&nbsp;&nbsp; Delegate Sub MathOperator(ByVal pt As Point3d)</p><p>&nbsp;&nbsp;&nbsp; Sub DelegateTest(ByVal pt As Point3d, ByVal op As MathOperator)</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; op.Invoke(pt)</p><p>&nbsp;&nbsp;&nbsp; End Sub</p><p>&nbsp;&nbsp;&nbsp; Public Sub ObjectMove2Mouse(ByVal pt As Point3d)</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim acadApp As AcadApplication = CType(Application.AcadApplication, AcadApplication)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim acadDoc As AcadDocument = acadApp.ActiveDocument<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Try<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Static blnFirst As Boolean = False<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Static blnFst As Boolean = False<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Static objTem(2) As AcadObject</p><p><br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim cirObj As AcadCircle<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim center(2) As Double<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim radius As Double<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim lineObj As AcadLine<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim sPnt(2), ePnt(2) As Double<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim textObj As AcadText<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim istPoint(2) As Double</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; center(0) = pt(0) + 0 : center(1) = pt(1) + 0 : center(2) = pt(2) + 0 : radius = 50<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; sPnt(0) = center(0) : sPnt(1) = center(1) : sPnt(2) = 0<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ePnt(0) = center(0) + 100 : ePnt(1) = center(1) + 100 : ePnt(2) = 0<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; istPoint(0) = center(0) : istPoint(1) = center(1) : istPoint(2) = center(2)</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If blnFirst = True Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For i As Integer = 0 To 2<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; objTem(i).Delete()&nbsp;&nbsp;&nbsp; '删除上次绘制的对象<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; cirObj = acadDoc.ModelSpace.AddCircle(center, radius)&nbsp; '创建一个圆对象<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; cirObj.color = ACAD_COLOR.acRed&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '将圆的颜色设为红色<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; lineObj = acadDoc.ModelSpace.AddLine(sPnt, ePnt)&nbsp;&nbsp; '创建一条直线<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; lineObj.Lineweight = ACAD_LWEIGHT.acLnWt060<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; textObj = acadDoc.ModelSpace.AddText("哈！成了。", istPoint, 15) '创建单行文字<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; textObj.color = ACAD_COLOR.acWhite</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; objTem(0) = cirObj<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; objTem(1) = lineObj<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; objTem(2) = textObj<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; cirObj = acadDoc.ModelSpace.AddCircle(center, radius)&nbsp;&nbsp;&nbsp; '创建一个圆对象<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; cirObj.color = ACAD_COLOR.acRed&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '将圆的颜色设为红色&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; lineObj = acadDoc.ModelSpace.AddLine(sPnt, ePnt)&nbsp;&nbsp;&nbsp; '创建一条直线<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; lineObj.Lineweight = ACAD_LWEIGHT.acLnWt060<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; textObj = acadDoc.ModelSpace.AddText("哈！成了。", istPoint, 15) '创建单行文字<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; textObj.color = ACAD_COLOR.acWhite</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; objTem(0) = cirObj<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; objTem(1) = lineObj<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; objTem(2) = textObj<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; blnFirst = True</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Catch ex As Exception</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End Try</p><p>&nbsp;&nbsp;&nbsp; End Sub</p><p>End Class</p>

azbd 发表于 2008-1-27 09:59:00

回复：（scs5999）利用VB写的随鼠标移动的图形

加入鼠标事件方法值得借鉴，但采用不断加入数据库对象、再不断删除的方法来实现动态显示的方法不可取

scs5999 发表于 2008-1-28 21:08:00

<p>重新修改为利用块移动</p><p>Imports Autodesk.AutoCAD.Runtime<br/>Imports Autodesk.AutoCAD.ApplicationServices<br/>Imports Autodesk.AutoCAD.EditorInput<br/>Imports Autodesk.AutoCAD.Geometry<br/>Imports Autodesk.AutoCAD.Interop<br/>Imports Autodesk.AutoCAD.Interop.Common</p><p>Public Class Class1</p><p>&nbsp;&nbsp;&nbsp; &lt;CommandMethod("mtest")&gt; _<br/>&nbsp;&nbsp;&nbsp; Public Sub test()</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim sd As New MotionalMousePoint<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; AddHandler ed.PointFilter, AddressOf sd.GetMousePoint<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim pro As PromptPointOptions = New PromptPointOptions("请选择插入点...")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ed.GetPoint(pro)</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; RemoveHandler ed.PointFilter, AddressOf sd.GetMousePoint</p><p>&nbsp;&nbsp;&nbsp; End Sub<br/>End Class</p><p>Public Class MotionalMousePoint</p><p>&nbsp;&nbsp;&nbsp; Private MousePoint As Point3d = New Point3d(0, 0, 0) '保存当前鼠标位置&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; ''动态获取鼠标位置&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Public Sub GetMousePoint(ByVal sender As Object, ByVal e As PointFilterEventArgs)</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MousePoint = e.Context.ComputedPoint<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim m_ed As Editor = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument.Editor</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; DelegateTest(MousePoint, AddressOf Move2Mouse)</p><p>&nbsp;&nbsp;&nbsp; End Sub</p><p>&nbsp;&nbsp;&nbsp; Delegate Sub MathOperator(ByVal pt As Point3d)</p><p>&nbsp;&nbsp;&nbsp; Sub DelegateTest(ByVal pt As Point3d, ByVal op As MathOperator)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; op.Invoke(pt)<br/>&nbsp;&nbsp;&nbsp; End Sub</p><p>&nbsp;&nbsp;&nbsp; Public Sub Move2Mouse(ByVal pt As Point3d)</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim acadApp As AcadApplication = CType(Application.AcadApplication, AcadApplication)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim acaddoc As AcadDocument = acadApp.ActiveDocument</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Try<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Static blnFirst As Boolean = False<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Static basePoint As Object</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Static blkRefObj As AcadBlockReference<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim insertPnt(2) As Double</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; insertPnt(0) = pt(0) + 0 : insertPnt(1) = pt(1) + 0 : insertPnt(2) = pt(2) + 0&nbsp;&nbsp;&nbsp; '指定模型空间的插入点</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim blkObject As AcadBlock<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim blkName As String = ""<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim blk As New CreateBlock</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For Each blkObject In acaddoc.Blocks()<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If blkObject.Name = "TestBlock1" And blnFirst = False Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; blkName = blkObject.Name<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; blkRefObj = acaddoc.ModelSpace.InsertBlock(insertPnt, blkName, 1.0#, 1.0#, 1.0#, 0.0#)&nbsp;&nbsp;&nbsp; '插入图块<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; basePoint = blkRefObj.InsertionPoint<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; blnFirst = True<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Exit For<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If blnFirst = True Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; blkRefObj.Move(basePoint, insertPnt)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; basePoint = blkRefObj.InsertionPoint<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; blkRefObj = blk.CreateBlock()<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; blkRefObj.Delete()<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'blkRefObj.Update()<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; 'acaddoc.Regen(AcRegenType.acActiveViewport)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Catch ex As Exception<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox(ex.Message)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End Try<br/>&nbsp;&nbsp;&nbsp; End Sub</p><p>End Class</p><p>Public Class CreateBlock</p><p>&nbsp;&nbsp;&nbsp; Public Function CreateBlock() As AcadBlockReference<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim acadApp As AcadApplication = CType(Application.AcadApplication, AcadApplication)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim acaddoc As AcadDocument = acadApp.ActiveDocument</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim blkObj As AcadBlock<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim insPnt(2) As Double<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim blkRefObj As AcadBlockReference<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim insertPnt(2) As Double</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; insPnt(0) = 0 : insPnt(1) = 0 : insPnt(2) = 0<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; insertPnt(0) = 0 : insertPnt(1) = 0 : insertPnt(2) = 0&nbsp;&nbsp;&nbsp; '指定模型空间的插入点</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; blkObj = acaddoc.Blocks.Add(insPnt, "TestBlock1") '在Blocks集合中创建名为TestBlock1的块对象</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '本段代码将在TestBlock1块对象中创建2个图元对象<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim cirObj As AcadCircle<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim center(0 To 2) As Double<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim radius As Double<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; center(0) = 0 : center(1) = 0 : center(2) = 0 : radius = 38</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim lineObj As AcadLine<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Dim sPnt(2), ePnt(2) As Double<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; sPnt(0) = center(0) : sPnt(1) = center(1) : sPnt(2) = 0<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; ePnt(0) = center(0) + 60 : ePnt(1) = center(1) + 80 : ePnt(2) = 0</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; cirObj = blkObj.AddCircle(center, radius)&nbsp;&nbsp;&nbsp; '创建一个圆对象<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; cirObj.color = ACAD_COLOR.acRed&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '将圆的颜色设为红色<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; lineObj = blkObj.AddLine(sPnt, ePnt)&nbsp;&nbsp;&nbsp;&nbsp; '创建一条直线</p><p>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; blkRefObj = acaddoc.ModelSpace.InsertBlock(insertPnt, "TestBlock1", 1.0#, 1.0#, 1.0#, 0.0#)&nbsp;&nbsp;&nbsp; '插入图块<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Return blkRefObj<br/>&nbsp;&nbsp;&nbsp; End Function<br/>End Class</p>

lysgyx 发表于 2008-3-5 09:57:00

<p>十分感谢！！</p><p>学习一下</p>

houlinbo 发表于 2008-3-28 11:34:00

我现在也用的是这种方法，但还是有一些缺点：<br/>1.需要删除添回循环； <br/>2.移动过的地方都会留下对象捕捉点，使CAD中的对象捕捉功能不能很好利用；<br/>3.不能像CAD中移动功能一样移动<br/><br/>

sieben 发表于 2008-3-29 11:38:00

没有详细看！只是这类问题不能利用Jig类吗？

claotlaot 发表于 2008-6-29 17:04:00

收藏下来了，有时间学习学习

tbeahgl 发表于 2008-9-20 11:17:00

<p>我赞成SIEBEN的想法,我利用EntityJig类已编出代码,也比较好用.网上有关于这方面的资料.</p>

lihezhou 发表于 2015-1-7 18:32:40

这个只能说明是一个例子。实际应用是采用这样的方便是下策！
页: [1]
查看完整版本: 利用VB写的随鼠标移动的图形