弧线（&P）
给我一个弧，但我不能从弧的中心和弧的中心弧到一条线的开始，请帮忙“Visual Basic与AutoCAD软件” 有趣的问题。。。也许可以上传图纸并提供有关问题的更多细节？ Visual Basic与AutoCAD软件 从中的屏幕截图上传您的图片。jpeg或。png格式
告诉我们你想要什么
<CommandMethod("twoarcs")> _
Public Sub AddArcsOnLine()
Dim acDoc As Document = Autodesk.AutoCAD.ApplicationServices.Application.DocumentManager.MdiActiveDocument
Dim ed As Editor = acDoc.Editor
Dim db As Database = acDoc.Database
Dim mtx As Matrix3d = ed.CurrentUserCoordinateSystem
Dim ucs As CoordinateSystem3d = mtx.CoordinateSystem3d
Try
Using tr As Transaction = db.TransactionManager.StartTransaction
Dim peo As New PromptEntityOptions(vbLf & "Select line >>")
peo.SetRejectMessage(vbLf & "Selected is not a line>>")
peo.AddAllowedClass(GetType(Line), False)
Dim res As PromptEntityResult
res = ed.GetEntity(peo)
If res.Status <> PromptStatus.OK Then
Return
End If
Dim ent As Entity = DirectCast(tr.GetObject(res.ObjectId, OpenMode.ForRead), Entity)
If ent Is Nothing Then
Return
End If
Dim lin As Line = Nothing
If TypeOf ent Is Line Then
lin = DirectCast(ent, Line)
End If
Dim btr As BlockTableRecord = tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite) '<-- get current space
Dim plan As Plane = New Plane(Point3d.Origin, ucs.Zaxis)
Dim p1 As Point3d = lin.StartPoint
Dim p2 As Point3d = lin.EndPoint
Dim ang = lin.Angle
Dim mpt As Point3d = New Point3d((p1.X + p2.X) / 2, (p1.Y + p2.Y) / 2, (p1.Z + p2.Z) / 2)
Dim cpt1 As Point3d = New Point3d((p1.X + mpt.X) / 2, (p1.Y + mpt.Y) / 2, (p1.Z + mpt.Z) / 2)
Dim cpt2 As Point3d = New Point3d((mpt.X + p2.X) / 2, (mpt.Y + p2.Y) / 2, (mpt.Z + p2.Z) / 2)
Dim arc1 As Arc = New Arc(cpt1, lin.GetDistAtPoint(cpt1), ang, Math.PI + ang)
arc1.Normal = lin.Normal
btr.AppendEntity(arc1)
tr.AddNewlyCreatedDBObject(arc1, True)
Dim arc2 As Arc = New Arc(cpt2, lin.GetDistAtPoint(cpt1), ang, Math.PI + ang)
arc1.Normal = lin.Normal
btr.AppendEntity(arc2)
tr.AddNewlyCreatedDBObject(arc2, True)
tr.Commit()
End Using
Catch ex As System.Exception
Autodesk.AutoCAD.ApplicationServices.Application.ShowAlertDialog(String.Format( _
"ERROR: " & Environment.NewLine & "{0}" & Environment.NewLine _
& "TRACE: " + Environment.NewLine + "{1}", ex.Message, ex.StackTrace))
Finally
'do nothing
End Try
End Sub
亲爱的…
在感谢你回答我所有问题的同时，我想知道你是否可以帮助我更多。
我想再次提出我的问题，因为你的回答不是我需要的。问题是，我们需要锥形罐顶的开发及其相关程序。我们得到了圆锥形，所以我们有所有的圆锥形数据。
顺致敬意， 你这么懒把照片贴在这里吗
而不是你的错误问题？
我在帖子4中要求你上传一张照片
对不起，我要离开这里，
你自己做你的工作 ///////////////////////////////////////////////////////////
http://up.iranblog.com/images/jc4ckiaxekogtewo5lz.bmp
http://up.iranblog.com/images/jc4ckiaxekogtewo5lz.bmp
http://up.iranblog.com/images/jc4ckiaxekogtewo5lz.bmp
尊敬的fixo：，
对于给您带来的不便，我深表歉意，我不是故意的，我真的急需找到答案。我想知道你是否能像往常一样帮我。请查收这张照片。提前谢谢。为了更好地理解这个问题，请注意
附加文件。
顺致敬意， 试试这个
希望它能让你开始
查看帮助文件中的其他内容
Option Explicit
Public Sub AddTwoArcs()
Dim sset As AcadSelectionSet
Dim dxfCode, dxfValue
Dim ftype(0) As Integer
Dim fdata(0) As Variant
ftype(0) = 0: fdata(0) = "LINE"
dxfCode = ftype: dxfValue = fdata
Dim lineObj As Object
Dim oEnt As AcadEntity
Dim stPt As Variant
Dim endPt As Variant
Dim movePt As Variant
Dim perpAng As Double
Dim rotAng As Double
Dim PI As Double
PI = Atn(1) * 4
' Define the new selection set object
With ThisDrawing.SelectionSets
While .Count > 0
.Item(0).Delete
Wend
Set sset = .Add("$Lines$")
End With
sset.SelectOnScreen dxfCode, dxfValue
If sset.Count = 0 Then
MsgBox ("No lines selected")
Exit Sub
End If
For Each oEnt In sset
' get the line object
Set lineObj = oEnt
stPt = lineObj.StartPoint
endPt = lineObj.EndPoint
Dim dblAng As Double
' get line angle
dblAng = lineObj.Angle
Dim mpt(2) As Double
Dim cpt1(2) As Double
Dim cpt2(2) As Double
Dim leng As Double
leng = lineObj.Length
Dim tmp As Variant
tmp = ThisDrawing.Utility.PolarPoint(stPt, dblAng, leng / 4)
cpt1(0) = tmp(0): cpt1(1) = tmp(1): cpt1(2) = 0#
tmp = ThisDrawing.Utility.PolarPoint(stPt, dblAng, leng * 0.75)
cpt2(0) = tmp(0): cpt2(1) = tmp(1): cpt2(2) = 0#
Dim oArc1 As AcadArc
Set oArc1 = ThisDrawing.ModelSpace.AddArc(cpt1, leng / 4, dblAng, dblAng + PI)
Dim oArc2 As AcadArc
Set oArc2 = ThisDrawing.ModelSpace.AddArc(cpt2, leng / 4, dblAng, dblAng + PI)
Next
End Sub
我现在更改了代码，对你来说没问题
非常感谢您的友好回答。
页:
[1]
2