|
|
大虾们，偶请教一个关于sendcommand使用小问题
偶想使用sendcommand,然后使用stretch 可是后面的字符串都需要什么呢，偶试了上午只找到的头两个对象（见代码），后面的对角点，和基点不知道怎么弄了~~~~~
大家帮忙给试试，谢了，谢了~~~~~~
代码部分：
Option Explicit
Sub sTestStretch()
Dim vPnt1, vPnt2, vPnt3
vPnt1 = ThisDrawing.Utility.GetPoint
vPnt2 = ThisDrawing.Utility.GetPoint(vPnt1)
vPnt3 = ThisDrawing.Utility.GetPoint(vPnt2)
Dim objLine1 As AcadLine
Dim objLine2 As AcadLine
Dim objCircle As AcadCircle
Set objLine1 = ThisDrawing.ModelSpace.AddLine(vPnt1, vPnt2)
Set objLine2 = ThisDrawing.ModelSpace.AddLine(vPnt2, vPnt3)
Set objCircle = ThisDrawing.ModelSpace.AddCircle(vPnt2, 5)
ThisDrawing.SendCommand "Stretch " & fGetDoubleEntTable(objLine1, vPnt1) & " " & _
fGetDoubleEntTable(objLine2, vPnt2) & " "
End Sub'函数名称：fGetDoubleEntTable
'功能描述：转换双元表的函数
'接收参数：objEntity双元表中的图元对象，vPnt点对象
'返回参数：双元表字符串
'更改人员及日期 Angus@20031027
Private Function fGetDoubleEntTable(objEntity As AcadEntity, vPnt As Variant) As String
Dim entHandle As String
entHandle = objEntity.Handle
fGetDoubleEntTable = "(list(handent " & Chr(34) & entHandle & Chr(34) & _
")(list " & Str(vPnt(0)) & Str(vPnt(1)) & Str(vPnt(2)) & "))"
End Function
'函数名称：faxPoint2lspPoint
'功能描述：转换点的函数
'接收参数：vPnt双元表中的点对象
'返回参数：点对象字符串
'更改人员及日期 Angus@20031027
Private Function faxPoint2lspPoint(vPnt As Variant) As String
faxPoint2lspPoint = vPnt(0) & "," & vPnt(1) & "," & vPnt(2)
End Function
'函数名称：faxEnt2lspEnt
'功能描述：转换图元函数
'接收参数：objEntity双元表中的图元对象
'返回参数：图元对象字符串
'更改人员及日期 Angus@20031027
Private Function faxEnt2lspEnt(objEntity As AcadEntity) As String
Dim entHandle As String
entHandle = objEntity.Handle
faxEnt2lspEnt = "(handent " & Chr(34) & entHandle & Chr(34) & ")"
End Function
加上图片~~~
ofd5tmbe505.jpg
|
|
置顶卡
