请教用sendcommand命令圆角问题

12qq21

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

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

LLLANHAN

我已经试验成功了。。。感谢高人的指点，对于那个点的设定，我的理解是，点是用来确定，圆角倒的方向的，所以，点只要设定在要倒圆角的内部就可以了。

整个的程序代码如下：供大家指证。。。

Public AcadApp As AcadApplication
'Public oDocument As Object
Dim centerPoint(0 To 2) As Double

Public 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 Function

Private Sub Command1_Click()

''''''''''''''''''''''''''''''''''''''''''''''''''''Addarc

Dim 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 = acRed

startPointNx = arcNxObj.StartPoint
endPointNx = arcNxObj.EndPoint
endPointNs = arcNsObj.EndPoint
startPointNs = arcNsObj.StartPoint
Dim lineObj1 As Object
Dim lineObj2 As Object

Set 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 & vbCr

Dim 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 = acGreen

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 & 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 = Nothing

End Sub

LLLANHAN

LLLANHAN

请教高人有一个新的问题，

我想将所有的图元都加入一个块，然后用这个块进行阵列，因为，放在集中，集无法阵列

现在已经知道了，圆弧和线在创建时，就再块中创建，但是倒圆角出来的是个圆弧，由于是用sendcommand出来的，如何再加入已有的块中。

blockobj中该如何加入已存在的图元？？？？？

mccad

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

LLLANHAN

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

我担心阵列完，图元太多了。

rekygj

学习了，正在研究