使用SendCommand命令执行fillet倒角功能
<p>问题提出:</p><p>VBA没有处理fillet的功能,我用SendCommand调用fillet命令进行了组合,VBA中实现了在倒圆角功能.</p><p>关键语句 Dim Command As String<br/> Command = "fillet" + Chr(10) + "R" + Chr(10) + "300" + Chr(10) + Chr(10)<br/> obj_Doc.SendCommand Command<br/></p><p>实际运行运行语句如下：</p><p> Dim cn As ADODB.Connection<br/> Dim rst As ADODB.Recordset<br/> ''<br/> Set cn = New ADODB.Connection<br/> cn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" _<br/> & App.Path & "\directory.mdb;"<br/> Set rst = New ADODB.Recordset<br/> rst.Open "pipeline", cn, adOpenKeyset, adLockPessimistic<br/> rst.MoveFirst<br/> <br/> Dim Command As String<br/> Command = "fillet" + Chr(10) + "R" + Chr(10) + "300" + Chr(10) + Chr(10) '设置倒圆角的半径<br/> obj_Doc.SendCommand Command<br/> <br/> Dim point1(0 To 2) As Double, point2(0 To 2) As Double, point3() As Double<br/> Dim ii As Integer<br/> ii = 0<br/> Do Until rst.EOF<br/> point1(0) = rst!PointX: point1(1) = rst!PointY: point1(2) = rst!PointZ<br/> rst.MoveNext<br/> If rst.EOF Then<br/> Exit Do<br/> Else<br/> point2(0) = rst!PointX: point2(1) = rst!PointY: point2(2) = rst!PointZ<br/> Set Ent = obj_ModelSpace.addline(point1, point2)<br/> rst.Fields(1).Value = Trim(Ent.Handle) ＇获取直线的handle数据<br/> <br/> End If<br/> <br/> Loop<br/> <br/> 通过数据库，调用两相邻直线段的handle数据，实现倒圆角的功能． <br/> Command = "fillet" + Chr(10) + "(handent " & Chr(34) & Str_Handle(ii) & Chr(34) & ")" & Chr(10) + "(handent " & Chr(34) & Str_Handle(ii + 1) & Chr(34) & ")" & Chr(10)<br/> obj_Doc.SendCommand Command</p><p></p><p>存在问题：</p><p>SendCommand 是将ＶＢＡ数据整合为Auto CAD的组合命令，现在倒角的功能已经实现，但不能获取生成后的圆弧的ＩＤ号，不能对其进行扩展运行,建立三维管道模型．</p><p>要找到这个弧的handle我用的方法是for each ent in thisdrawing, 但不能与建立直线相关联．</p><p></p><p><br/> </p><p></p><p></p> <p>用ENTLAST可不可以？</p><p>相当于ssget "L"，VBA不太懂，反正在VL 中这很简单。</p> <p>我现在的关键问题有两个解决方案</p><p>1 用ENTLAST,获取handle数据,采用XRecord方法,看了示例就头晕.</p><p>2 采用object.Select命令,Mode采用acSelectionSetLast,获取handle,但没有示例程序.</p><p>我在运行object.Select时经常出现错误,＂命名选择集已经存在＂.</p><p>通过</p><p> Dim ssetObj As AcadSelectionSet<br/> If Not ssetObj Then<br/> Set ssetObj = ThisDrawing.SelectionSets.Add("SSET")<br/> End If<br/>也不能屏蔽出现的错误,＂命名选择集已经存在＂</p><p>这也是我解决上面帖子的一个关键问题．</p><p></p> <p>vba也可获得最后生成的实体</p><p> Set TheLastObj = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)</p> <p>对于使用 SendCommand来实现象倒角、截断、延伸、修剪这样的问题，在2002年已经讨论过。</p><p>可参见：<a href="http://www.mjtd.com/Develop/ArticleShow.asp?ArticleID=351">http://www.mjtd.com/Develop/ArticleShow.asp?ArticleID=351</a></p><p>你的圆角有点问题，这里也涉及到双元表的问题。因为我上面提到的几个命令，都与鼠标点击的位置有关。就象是圆角，是从哪一端圆角，就看你鼠标点击的位置了，所以在程序里就有一个特殊的表“双元表”，专门来处理这样的问题。</p> 高手就高手，一条指令就解决我好多天的困扰，谢谢． <p>请教版主们，为什么在两条轻量多段线倒角时却不予执行呢？</p><p>det1 = GetDoubleEntTable(LWPineObj1, pickPt1)<br/>det2 = GetDoubleEntTable(LWPineObj2, pickPt2)<br/>ThisDrawing.SendCommand "_chamfer" & vbCr & "d" & vbCr & "0" & vbCr & "0" & vbCr & det1 & vbCr & det2 & vbCr<br/></p><p>这应该没什么错误啊，请问是怎么回事？</p> <p>在图形界面下chamfer就一切正常，用VBA倒角同样的两条线就没有任何反应，真是莫明其妙，我觉得如上贴我写的没问题啊，执行其它两种线型都正常，就是多段线与多段线不行，请求高手帮助。</p> <p>难道没人遇到过这个问题？有没有用SendCommand倒角多段线与多段线成功的？</p><p>我不知是我的错误还是这样就是不行。请高手指点。谢谢。</p> 不太理解用VBA实现这样的操作有什么用途？用VBA调用LSP执行类似操作不行吗？
页:
[1]
2