在UCS中怎么画图？

ahlzl · 发表于 2004-5-29 20:51:00

论坛的CAD高级应用版有个画“偏心圆台”的问题。我写了程序，可只能在WCS中画，在UCS中画的问题一直没解决，请高手相助！

Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.Interop
Imports Autodesk.AutoCAD.Interop.Common
Imports System.MathPublic Class Class1_程序
'公用设置
Const pi = 3.1415926535
Dim app As AcadApplication = Application.AcadApplication
Dim doc As AcadDocument = app.ActiveDocument
Dim ms As Object = doc.ModelSpace
Dim ut As Object = doc.Utility '------------------------函数库------------------------------
Function dis(ByVal pa As Object, ByVal pb As Object) As Double
Return Sqrt((pa(0) - pb(0)) ^ 2 + (pa(1) - pb(1)) ^ 2 + (pa(2) - pb(2)) ^ 2)
End Function
<CommandMethod("px")> Sub Cmd5_偏心圆台() MsgBox("程序将在世界坐标系中画偏心圆台！", , "AutoCAD 2005")
doc.SendCommand("UCS" & vbCr & "w" & vbCr)
Dim point As Object = ut.GetPoint(, "请输入偏心圆台的底面中心点:")
Dim R1 As Double = ut.GetDistance(point, "请输入偏心圆台的底面半径：")
Dim h As Double = ut.GetDistance(point, "请输入偏心圆台的高度：")
Dim R2 As Double = ut.GetDistance(point, "请输入偏心圆台的顶面半径：")
Dim d As Double = ut.GetDistance(point, "请输入偏心圆台的偏心距离：") If R2 >= R1 Then
MsgBox("因工作较忙，程序尚未全部完成，只能画顶面半径小于底面半径的偏心圆台！", , "AutoCAD 2005")
Exit Sub
End If
Dim h1 As Double = h * R1 / (R1 - R2)
Dim dd As Double = h1 * d / h Dim p0(2) As Double : Dim p1(2) As Double
Dim p2(2) As Double : Dim p3(2) As Double
p0(0) = dd + point(0) : p0(1) = point(1) : p0(2) = h1 + point(2)
p1(0) = R1 + point(0) : p1(1) = point(1) : p1(2) = point(2)
p2(0) = -R1 + point(0) : p2(1) = point(1) : p2(2) = point(2) Dim L1 As Double = dis(p1, p0)
Dim L2 As Double = dis(p2, p0) p3(0) = R1 * (L2 - L1) / (L1 + L2) + point(0)
p3(1) = point(1) : p3(2) = point(2) Dim L3 As Double = dis(p3, p0)
Dim L12 As Double = dis(p1, p2)
Dim L13 As Double = dis(p1, p3)
Dim L23 As Double = dis(p2, p3) Dim e As Double = (L2 ^ 2 + L3 ^ 2 - L23 ^ 2) / (2 * L2 * L3)
Dim ang As Double = Atan(-e / Sqrt(-e * e + 1)) + 2 * Atan(1) Dim b As Double = L3 * Tan(ang)
Dim a As Double = Sqrt(L23 * L13) Dim EL As Acad3DSolid _
= ms.AddEllipticalCone(p3, 2 * b, 2 * a, 2 * L3) Dim e2 As Double _
= (L23 ^ 2 + L3 ^ 2 - L2 ^ 2) / (2 * L23 * L3)
Dim ang2 As Double _
= Atan(-e2 / Sqrt(-e2 * e2 + 1)) + 2 * Atan(1) - 0.5 * pi Dim p333(2) As Double
p333(0) = p3(0) : p333(1) = p3(1) + 1 : p333(2) = p3(2)
EL.Rotate3D(p3, p333, ang2) Dim spt1(2) As Double, spt2(2) As Double
Dim spt3(2) As Double
Dim sliceObj As Acad3DSolid
spt1(0) = point(0) : spt1(1) = point(1) : spt1(2) = point(2)
spt2(0) = point(0) : spt2(1) = point(1) + 1 : spt2(2) = point(2)
spt3(0) = point(0) + 1 : spt3(1) = point(1) : spt3(2) = point(2)
sliceObj = EL.SliceSolid(spt1, spt2, spt3, False) spt1(0) = point(0) : spt1(1) = point(1) : spt1(2) = point(2) + h
spt2(0) = point(0) + 1 : spt2(1) = point(1) : spt2(2) = point(2) + h
spt3(0) = point(0) : spt3(1) = point(1) + 1 : spt3(2) = point(2) + h
sliceObj = EL.SliceSolid(spt1, spt2, spt3, False)
doc.Regen(AcRegenType.acAllViewports)
app.ZoomExtents() End SubEnd Class

Imports Autodesk.<a href="http://bbs.mjtd.com/forum-41-1.html" target="_blank" class="relatedlink">AutoCAD</a>.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.Interop
Imports Autodesk.AutoCAD.Interop.Common
Imports System.MathPublic Class Class1_程序
       '公用设置
       Const pi = 3.1415926535
       Dim app As AcadApplication = Application.AcadApplication
       Dim doc As AcadDocument = app.ActiveDocument
       Dim ms As Object = doc.ModelSpace
       Dim ut As Object = doc.Utility       '------------------------函数库------------------------------
       Function dis(ByVal pa As Object, ByVal pb As Object) As Double
               Return Sqrt((pa(0) - pb(0)) ^ 2 + (pa(1) - pb(1)) ^ 2 + (pa(2) - pb(2)) ^ 2)
       End Function
<CommandMethod("px")> Sub Cmd5_偏心圆台()               MsgBox("程序将在世界坐标系中画偏心圆台！", , "AutoCAD 2005")
               doc.SendCommand("UCS" & vbCr & "w" & vbCr)
               Dim point As Object = ut.GetPoint(, "请输入偏心圆台的底面中心点:")
               Dim R1 As Double = ut.GetDistance(point, "请输入偏心圆台的底面半径：")
               Dim h As Double = ut.GetDistance(point, "请输入偏心圆台的高度：")
               Dim R2 As Double = ut.GetDistance(point, "请输入偏心圆台的顶面半径：")
               Dim d As Double = ut.GetDistance(point, "请输入偏心圆台的偏心距离：")               If R2 >= R1 Then
                       MsgBox("因工作较忙，程序尚未全部完成，只能画顶面半径小于底面半径的偏心圆台！", , "AutoCAD 2005")
                       Exit Sub
               End If
               Dim h1 As Double = h * R1 / (R1 - R2)
               Dim dd As Double = h1 * d / h               Dim p0(2) As Double : Dim p1(2) As Double
               Dim p2(2) As Double : Dim p3(2) As Double
               p0(0) = dd + point(0) : p0(1) = point(1) : p0(2) = h1 + point(2)
               p1(0) = R1 + point(0) : p1(1) = point(1) : p1(2) = point(2)
               p2(0) = -R1 + point(0) : p2(1) = point(1) : p2(2) = point(2)               Dim L1 As Double = dis(p1, p0)
               Dim L2 As Double = dis(p2, p0)               p3(0) = R1 * (L2 - L1) / (L1 + L2) + point(0)
               p3(1) = point(1) : p3(2) = point(2)               Dim L3 As Double = dis(p3, p0)
               Dim L12 As Double = dis(p1, p2)
               Dim L13 As Double = dis(p1, p3)
               Dim L23 As Double = dis(p2, p3)               Dim e As Double = (L2 ^ 2 + L3 ^ 2 - L23 ^ 2) / (2 * L2 * L3)
               Dim ang As Double = Atan(-e / Sqrt(-e * e + 1)) + 2 * Atan(1)               Dim b As Double = L3 * Tan(ang)
               Dim a As Double = Sqrt(L23 * L13)               Dim EL As Acad3DSolid _
               = ms.AddEllipticalCone(p3, 2 * b, 2 * a, 2 * L3)               Dim e2 As Double _
               = (L23 ^ 2 + L3 ^ 2 - L2 ^ 2) / (2 * L23 * L3)
               Dim ang2 As Double _
               = Atan(-e2 / Sqrt(-e2 * e2 + 1)) + 2 * Atan(1) - 0.5 * pi               Dim p333(2) As Double
               p333(0) = p3(0) : p333(1) = p3(1) + 1 : p333(2) = p3(2)
               EL.Rotate3D(p3, p333, ang2)               Dim spt1(2) As Double, spt2(2) As Double
               Dim spt3(2) As Double
               Dim sliceObj As Acad3DSolid
               spt1(0) = point(0) : spt1(1) = point(1) : spt1(2) = point(2)
               spt2(0) = point(0) : spt2(1) = point(1) + 1 : spt2(2) = point(2)
               spt3(0) = point(0) + 1 : spt3(1) = point(1) : spt3(2) = point(2)
               sliceObj = EL.SliceSolid(spt1, spt2, spt3, False)               spt1(0) = point(0) : spt1(1) = point(1) : spt1(2) = point(2) + h
               spt2(0) = point(0) + 1 : spt2(1) = point(1) : spt2(2) = point(2) + h
               spt3(0) = point(0) : spt3(1) = point(1) + 1 : spt3(2) = point(2) + h
               sliceObj = EL.SliceSolid(spt1, spt2, spt3, False)
               doc.Regen(AcRegenType.acAllViewports)
               app.ZoomExtents()       End SubEnd Class

TranslateCoordinates 方法我也用了，可还是……

ahlzl · 发表于 2004-5-29 21:03:00

TranslateCoordinates 方法我也用了，可还是……

账号		自动登录	找回密码
密码			注册