在UCS中怎么画图？
论坛的CAD高级应用版有个画“偏心圆台”的问题。我写了程序，可只能在WCS中画，在UCS中画的问题一直没解决，请高手相助！Imports Autodesk.AutoCAD.ApplicationServicesImports 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 ClassTranslateCoordinates 方法我也用了，可还是……
<SPAN class=LinkActivexMethod onclick=alink_TranslateCoordinates_AXM_404566.Click();>TranslateCoordinates 方法我也用了，可还是…… <BR></SPAN>
页:
[1]