winddeity 发表于 2003-7-25 14:16:00

我用sendcommand的_trim命令,经常剪不断,怎么办?

是从“实用函数”里学到的方法,做了一些修改:

Public Sub Trim(ByVal cutLine1 As AcadLine, ByVal cutLine2 As AcadLine, _
                ByVal entSP As AcadSpline, ByVal optCode As String)
'cutLine1 cutLine2是_trim的两个边界线,endSP是要剪的样条曲线。

    Dim det1, det2 As String
    det1 = axEnt2lspEnt(cutLine1)
    det2 = axEnt2lspEnt(cutLine2)

    Dim det3, det4 As String
    det3 = GetDoubleEntTable(entSP, entSP.GetControlPoint(0))
    det4 = GetDoubleEntTable(entSP, entSP.GetControlPoint(entSP.NumberOfControlPoints - 1))
   
    If optCode = "first" Then
      ThisDrawing.SendCommand "_trim" & vbCr & det2 & vbCr & _
             vbCr & det4 & vbCr & vbCr
      GoTo rtn
    End If
   
    If optCode = "last" Then
      ThisDrawing.SendCommand "_trim" & vbCr & det1 & vbCr & _
            vbCr & det3 & vbCr & vbCr
      GoTo rtn
    End If
   
    ThisDrawing.SendCommand "_trim" & vbCr & det1 & vbCr & det2 & _
          vbCr & vbCr & det3 & vbCr & det4 & vbCr & vbCr
rtn:
End Sub

'转换双元表的函数
Private 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 Function axPoint2lspPoint(Pnt As Variant) As String
    axPoint2lspPoint = Pnt(0) & "," & Pnt(1) & "," & Pnt(2)
End Function

'转换图元函数
Private Function axEnt2lspEnt(entObj As AcadEntity) As String
    Dim entHandle As String
    entHandle = entObj.Handle
    axEnt2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function

作用主要是把样条曲线其中两个拟合点之间的一段剪出来,但在弯比较急的地方经常剪不断,造成出错。请问怎么办?

myfreemind 发表于 2003-7-25 21:22:00

还是用VLISP来写剪裁程序吧,我觉得用VBA太麻烦了!

winddeity 发表于 2003-7-26 14:13:00

但这是一个比较大的程序中得一个小函数啊:(

mccad 发表于 2003-7-27 09:24:00

把剪不断的图放上来。

winddeity 发表于 2003-7-27 18:57:00

老大你终于发话了:(
.dwg文件和.dvb文件都传上来了。.dvb是我临时写的,做得很粗糙但能发现问题,(trim函数也作了一些改动)。执行宏选择那条样条曲线就可以看到有的地方剪不断,这种情况经常发生。使整个程序稳定性很差。
还有,有时候画两条线相交,autoCAD却找不到交点,用vba的intersectWith方法也找不到。我想可能是同一个原因。

还有还有两个问题(不好意思):
1。在我运行程序的时候能不能让命令窗口不显示我正在执行的操作?就是说我运行一个程序时命令窗口能不能没有显示。(好像lisp的可以)
2。在用Thisdrawing.utility.GetEntity方法怎样来区分“没选中实体”和“按下了Esc键”两个事件?上次您写过用API实现的方法,但没看懂,能不能讲讲?

非常感谢!!

mccad 发表于 2003-7-27 19:46:00

这不是程序的问题,而是软件的问题。
但不知你使用该修剪最后想实现什么功能,如果能够说明倒可以帮你找找有没有其它方法。
如果只是想对样条曲线在拟合点处进行分段可以使用Break这样的命令来解决。

winddeity 发表于 2003-7-28 19:27:00

用break和用trim是一样的,vba里都没有啊。在我借用的trim函数中都包含了break函数,两者内部函数都是一样的,只是外部接口不一样。所以我想结果也是一样的。

我现在需要用一系列圆弧段来拟合已知的样条曲线。由于cad中央条曲线出了拟合点和控制点外的其他点都无法得到,我的做法是找交点:用一条直线和样条相交,交点一定在样条上。为了避免多值,需要将样条分段,而且在达不到精度的情况下还需要进一步细分。

现在有两个问题:1。trim剪不断。2。intersectwith找不到交点。两者都致命!找不到交点的情况现在我换了算法避免了,但剪不断实在是无法解决啊。

希望您能帮忙。 think you .

mccad 发表于 2003-7-28 19:42:00

如果你需要在样条曲线上找点,然后再用直线来模拟样条曲线的话,则可以使用以下方法:
使用VLAX类(其它贴子有介绍),然后求曲线的总长度,然后再求曲线上与起点指定距离的线上的点。
通过这些求得的点你就可以用线来模拟出样条曲线。
以上所说的函数在实用函数中都有。

winddeity 发表于 2003-7-29 02:47:00

可是我需要的是圆弧拟合:(,而且相邻圆弧相切。精度为0.001。
圆弧拟合的算法我是有的,但必须得到足够多的曲线上的点(拟合点),还有该拟合点出的切线方向(以保证与原曲线足够相似)。

gfwu888 发表于 2018-2-3 14:02:32

有时候画两条线相交,autoCAD却找不到交点,用vba的intersectWith方法也找不到的原因是这两条线必须是在同一个层里才行
页: [1] 2
查看完整版本: 我用sendcommand的_trim命令,经常剪不断,怎么办?