请教用sendcommand命令圆角问题

LLLANHAN

请教各位高人帮助

我想实现圆弧和线段的圆角处理，引用论坛里牛人sendcommand代码，可以实现功能，但是倒出来的圆角位置不对，请高人，帮忙啊。。。

千恩万谢。。。。

代码如下，vb中写的。代码中红色这一段没搞清楚什么意思。但是程序是通的，而且的确倒了圆角，只是结果非我所要求的。如何改？？？

AcadApp.ActiveDocument.SendCommand "_fillet" & vbCr & "r" & vbCr & "5" & vbCr & "t" & vbCr & "t" & vbCr & "(handent " & Chr(34) & lineObj1.Handle & Chr(34) & ")" & vbCr & "(handent " & Chr(34) & arcNsObj.Handle & Chr(34) & ")" & vbCr

mccad

AutoCAD的圆角命令除是指定图元外，还与选择的点位置有关，如果选到的点是靠直线的起点，就优先做起点端的圆角，如果选的是靠终点，则优先做终点端的圆角，实际上你自己在AutoCAD中操作就知道，所以它是与选择的点有关。

你想做圆角，那就得知道你所需要圆角处是靠线的哪一端，在程序中给定的点就得用靠哪端的点，而不是直接给个图元或随便给个点的行。

mccad

http://www.mjtd.com/Develop/ArticleShow.asp?ArticleID=49

LLLANHAN

LLLANHAN

您提示的是vba中的转换，看不懂

ThisDrawing.Utility.GetEntity entObj, Pnt, "选择图元：" 这句代码，不知道在vb  中怎么对应啊。。。急。。。。。

这个看懂了。有个新的问题在下面

mccad

ThisDrawing=AcadApp.ActiveDocument

LLLANHAN

认证的学习了一下您的代码，有一点搞不清楚

  det2 = GetDoubleEntTable(entObj2, Pnt2) 函数，这个pnt2是什么东西，是图元entObj2上的点吗？？

        det2 = GetDoubleEntTable(entObj2, Pnt2)

这个det2 的转换，还是有点不理解，我的程序如下，麻烦高人看看，如何修改

我现在想做的是，不用选择图元，而是直接引用两个图元，lineObj1,和arcNsObj进行sendcommand 圆角命令，代码如下，结果还是和原来一样。

Dim Pnt1 As Variant

Dim det1 As String
det1 = axEnt2lspEnt(lineObj1)

Dim Pnt2 As Variant

Dim det2 As String
det2 = GetDoubleEntTable(arcNsObj, startPointNs) 'startpointNs 是arcNsObj图元的起点

AcadApp.ActiveDocument.SendCommand "_fillet" & vbCr & "r" & vbCr & "2" & vbCr & "t" & vbCr & "t" & vbCr & det1 & vbCr & vbCr & det2 & vbCr & vbCr

执行最后一句代码时，监视到

det1="(handent "89")"

det2="(list(handent "88")(list  25 0 0))"

LLLANHAN

这个是我用vb 编写的程序的完整代码，套用了版主的一些代码，呵呵，初学乍练，请大家拍砖帮助修改。

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

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
det1 = axEnt2lspEnt(lineObj1)

Dim Pnt2 As Variant

Dim det2 As String
det2 = GetDoubleEntTable(arcNsObj, startPointNs)

AcadApp.ActiveDocument.SendCommand "_fillet" & vbCr & "r" & vbCr & "2" & vbCr & "t" & vbCr & "t" & vbCr & det1 & vbCr & vbCr & det2 & vbCr & vbCr

'AcadApp.Quit

'Set oDocument = Nothing
'Set AcadApp = Nothing

End Sub

Private Sub Form_Load()

On Error Resume Next
Set acadpp = GetObject(, "AutoCAD.application")
   
If Err Then
    Err.Clear
    Set AcadApp = CreateObject("AutoCAD.application")
    If Err Then
        MsgBox ("不能运行autocad2004，请检查")
        Exit Sub
    End If
End If
AcadApp.Visible = True
'Set oDocument = AcadApp.ActiveDocument
'AcadApp.ActiveDocument.ActiveViewport.GridOn = True
'AcadApp.ActiveDocument.ActiveViewport = AcadApp.ActiveDocument.ActiveViewport

End Sub

雪山飞狐_lzh

这个倒圆角应该是可以算出来的？

LLLANHAN

只能回去再试试了,希望成功.

感谢mccad的关注和支持...