加载中…
个人资料
  • 博客等级:
  • 博客积分:
  • 博客访问:
  • 关注人气:
  • 获赠金笔:0支
  • 赠出金笔:0支
  • 荣誉徽章:
正文 字体大小:

使用VBA进行截断(break)和修剪(trim)

(2010-06-03 20:41:32)
标签:

vba

cad

裁剪命令

trim

break

打断

it

分类: 开发

在VBA中,我们可以通过SendCommand方法来发送命令给AutoCAD而对AutoCAD直接进行操作,就象LISP中的Command函数一样,但它却没有Command函数这么方便。因为Command函数可以直接接受LISP命令以及LISP提供的点坐标形式以及双元表等,所以它能够通过程序对图元进行修剪、截断、延伸等操作,但SendCommand方法却不能接受VBA提供的点坐标,不能接受VBA中的其它方法,象点坐标形式,而且也不能纵使出双元表这样的特殊格式,它只能象在命令行一样的输入在命令行中能识别的点形式及双元表。

所以说这个问题也难倒了多位的专家,一段时间以来,这个问题都被认为是一个不能解决的问题,虽然说有些专家也试图通过其它方式来解决,但毕竟要使用一些的控件,而且写出来的语句也难以看懂。

通过对SendCommand方法的研究,我们不难发现它可以接受与命令输入一模一样的语句,也就是说它也能够接受AutoLISP的函数以及相同格式的点坐标。这样,我们就可以通过VBA来制造这样的点坐标,也可以通过VBA来生成一些供SendCommand方法使用的组合起来的AutoLISP语句来表达的一个双元表。

大家应该可以明白了,我也通过以下的例子来给大家演示怎样通过这种形式对图元进行截断及修剪,在这里提供了三个函数供转换VBA形式为LISP形式用。

axPoint2lspPoint是转换VBA的点为SendCommand用的点格式;

axEnt2lspEnt是转换VBA的图元为SendCommand中用与供选择的图元格式;

GetDoubleEntTable是转换VBA的图元及点为SendCommand中用的双元表格式。

'示例Break

Sub Break()
    Dim Pnt As Variant
    Dim entObj As AcadEntity
    ThisDrawing.Utility.GetEntity entObj, Pnt, "选择图元:"
    Dim Pnt2 As Variant
    Pnt2 = ThisDrawing.Utility.GetPoint(, "选择点:")

    Dim det As String
    det = GetDoubleEntTable(entObj, Pnt)

    Dim lspPnt As String
    lspPnt = axPoint2lspPoint(Pnt2)
    ThisDrawing.SendCommand "_break" & vbCr & det & vbCr & lspPnt & vbCr

End Sub

'示例Trim

Sub Trim()

    Dim Pnt1 As Variant
    Dim entObj1 As AcadEntity
    ThisDrawing.Utility.GetEntity entObj1, Pnt1, "选择图元:"
    Dim det1 As String
    det1 = axEnt2lspEnt(entObj1)

    Dim Pnt2 As Variant
    Dim entObj2 As AcadEntity
    ThisDrawing.Utility.GetEntity entObj2, Pnt2, "选择被剪图元:"
    Dim det2 As String
    det2 = GetDoubleEntTable(entObj2, Pnt2)

    ThisDrawing.SendCommand "_trim" & vbCr & det1 & vbCr & vbCr & det2 & vbCr & vbCr

End Sub

'转换双元表的函数

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

'转换点的函数

Public Function axPoint2lspPoint(Pnt As Variant) As String
    axPoint2lspPoint = Pnt(0) & "," & Pnt(1) & "," & Pnt(2)
End Function

'转换图元函数

Public Function axEnt2lspEnt(entObj As AcadEntity) As String
    Dim entHandle As String
    entHandle = entObj.Handle
    axEnt2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function

0

阅读 收藏 喜欢 打印举报/Report
  

新浪BLOG意见反馈留言板 欢迎批评指正

新浪简介 | About Sina | 广告服务 | 联系我们 | 招聘信息 | 网站律师 | SINA English | 产品答疑

新浪公司 版权所有