请教用sendcommand命令圆角问题 - VBA/VB/ActiveX/API 编程技术 - AutoCAD论坛 - 明经CAD社区 - 第2页

12qq21 发表于 2009-9-3 12:47:00

mccad发表于2009-9-2 6:23:00static/image/common/back.gifAutoCAD的圆角命令除是指定图元外，还与选择的点位置有关，如果选到的点是靠直线的起点，就优先做起点端的圆角，如果选的是靠终点，则优先做终点端的圆角，实际上你自己在AutoCAD中操作就知道，

请问mccad,怎么在程序中给定个点来表示所要的圆角靠近哪个端？谢谢！

LLLANHAN 发表于 2009-9-4 11:51:00

我已经试验成功了。。。感谢高人的指点，对于那个点的设定，我的理解是，点是用来确定，圆角倒的方向的，所以，点只要设定在要倒圆角的内部就可以了。整个的程序代码如下：供大家指证。。。Public AcadApp As AcadApplication 'Public oDocument As Object Dim centerPoint(0 To 2) As DoublePublic Function axEnt2lspEnt(entObj As AcadEntity) As String Dim entHandle As String entHandle = entObj.Handle axEnt2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")" End Function Public Function GetDoubleEntTable(entObj As AcadEntity, Pnt As Variant) As String     Dim entHandle As String     entHandle = entObj.Handle     GetDoubleEntTable = "(list(handent " & Chr(34) & entHandle & Chr(34) & ")(list " & Str(Pnt(0)) & Str(Pnt(1)) & Str(Pnt(2)) & "))"  End FunctionPrivate Sub Command1_Click()''''''''''''''''''''''''''''''''''''''''''''''''''''AddarcDim arcNxObj As Object Dim arcNsObj As Object Dim radiusARCNx As Double Dim startAngleInDegreeN As Double Dim endAngleInDegreeN As Double Dim startAngleInRadianN As Double Dim endAngleInRadianN As Double 'Dim blockObj As AcadBlock 'Set blockObj = AcadApp.ActiveDocument.SelectionSets.Add("FWw") radiusARCNx = 15#startAngleInDegreeN = 0# endAngleInDegreeN = 45#startAngleInRadianN = startAngleInDegreeN * 3.141592 / 180# endAngleInRadianN = endAngleInDegreeN * 3.141592 / 180#Set arcNxObj = AcadApp.ActiveDocument.ModelSpace.AddArc(centerPoint, radiusARCNx, startAngleInRadianN, endAngleInRadianN)Dim arcNs As Object Dim radiusARCNs As Double radiusARCNs = 25#Set arcNsObj = AcadApp.ActiveDocument.ModelSpace.AddArc(centerPoint, radiusARCNs, startAngleInRadianN, endAngleInRadianN) Dim endPointNx As Variant Dim startPointNx As Variant Dim endPointNs As Variant Dim startPointNs As Variant arcNsObj.Color = acRedstartPointNx = arcNxObj.StartPoint endPointNx = arcNxObj.EndPoint endPointNs = arcNsObj.EndPoint startPointNs = arcNsObj.StartPoint Dim lineObj1 As Object Dim lineObj2 As ObjectSet lineObj1 = AcadApp.ActiveDocument.ModelSpace.AddLine(startPointNx, startPointNs) Set lineObj2 = AcadApp.ActiveDocument.ModelSpace.AddLine(endPointNx, endPointNs)ZoomExtents'''''''''''''''''''''''想实现fillet 直线与圆弧的圆角功能 Dim Pnt1 As Variant Dim det1 As String Dim Pnt2 As Variant Dim det2 As String det1 = axEnt2lspEnt(arcNsObj) Pnt2 = lineObj1.EndPoint Pnt2(0) = Pnt2(0) - 1 det2 = GetDoubleEntTable(lineObj1, Pnt2) AcadApp.ActiveDocument.SendCommand "_fillet" & vbCr & "r" & vbCr & "2" & vbCr & "t" & vbCr & "t" & vbCr & det1 & vbCr & vbCr & det2 & vbCrDim DaoJiao(4) As AcadEntity Set DaoJiao(0) = AcadApp.ActiveDocument.ModelSpace(AcadApp.ActiveDocument.ModelSpace.Count - 1) det1 = axEnt2lspEnt(arcNsObj) Pnt2 = lineObj2.EndPoint Pnt2(0) = Pnt2(0) - 1 det2 = GetDoubleEntTable(lineObj2, Pnt2) AcadApp.ActiveDocument.SendCommand "_fillet" & vbCr & "r" & vbCr & "2" & vbCr & "t" & vbCr & "t" & vbCr & det1 & vbCr & vbCr & det2 & vbCr Set DaoJiao(1) = AcadApp.ActiveDocument.ModelSpace(AcadApp.ActiveDocument.ModelSpace.Count - 1) det1 = axEnt2lspEnt(arcNxObj) Pnt2 = lineObj2.EndPoint arcNxObj.Color = acGreen Pnt2(0) = Pnt2(0) + 1 det2 = GetDoubleEntTable(lineObj2, Pnt2) AcadApp.ActiveDocument.SendCommand "_fillet" & vbCr & "r" & vbCr & "2" & vbCr & "t" & vbCr & "t" & vbCr & det1 & vbCr & vbCr & det2 & vbCr Set DaoJiao(2) = AcadApp.ActiveDocument.ModelSpace(AcadApp.ActiveDocument.ModelSpace.Count - 1) det1 = axEnt2lspEnt(arcNxObj) Pnt2 = lineObj1.EndPoint arcNxObj.Color = acGreenPnt2(0) = Pnt2(0) + 1 det2 = GetDoubleEntTable(lineObj1, Pnt2) AcadApp.ActiveDocument.SendCommand "_fillet" & vbCr & "r" & vbCr & "2" & vbCr & "t" & vbCr & "t" & vbCr & det1 & vbCr & vbCr & det2 & vbCr Set DaoJiao(3) = AcadApp.ActiveDocument.ModelSpace(AcadApp.ActiveDocument.ModelSpace.Count - 1)Dim rotationAngle As Double rotationAngle = 0.7853981 * 1.5 ' 45 degrees ReDim ssobjs(0 To AcadApp.ActiveDocument.ModelSpace.Count - 1) As AcadEntity Dim I As Integer For I = 0 To AcadApp.ActiveDocument.ModelSpace.Count - 1         Set ssobjs(I) = AcadApp.ActiveDocument.ModelSpace.Item(I)    ssobjs(I).Rotate centerPoint, rotationAngle Next    ZoomExtents  'Set oDocument = Nothing 'Set AcadApp = NothingEnd Sub

LLLANHAN 发表于 2009-9-4 11:58:00

LLLANHAN 发表于 2009-9-4 12:03:00

请教高人有一个新的问题，我想将所有的图元都加入一个块，然后用这个块进行阵列，因为，放在集中，集无法阵列现在已经知道了，圆弧和线在创建时，就再块中创建，但是倒圆角出来的是个圆弧，由于是用sendcommand出来的，如何再加入已有的块中。blockobj中该如何加入已存在的图元？？？？？

mccad 发表于 2009-9-4 12:16:00

不一定用到块吧。你可以每个图元单独进行阵列，写成一个函数就可以。

LLLANHAN 发表于 2009-9-4 12:31:00

我就担心每一个图元进行阵列，就要多一个阵列图元。我担心阵列完，图元太多了。

rekygj 发表于 2011-6-17 22:29:24

学习了，正在研究

页: 1 [2]

明经CAD社区's Archiver