社区 › VBA/VB/ActiveX/API 编程技术 › [求助]谁帮我看看，为什么offset这一步运行下不去了

subtlation 发表于 2003-12-19 09:54:00

[求助]谁帮我看看，为什么offset这一步运行下不去了

'运行到offset这一步就直接跳出entrimf子过程返回enttrim
Sub entTrim()
On Error Resume Next
Dim ent As AcadEntity
Dim pnt1 As Variant

ThisDrawing.Utility.GetEntity ent, pnt1, "选择多义线："
If Err Then Exit Sub
entTrimF ent
End Sub

Sub entTrimF(plineObj As AcadEntity)
    Dim offplineObj As AcadEntity
    Dim Coors As Variant
    Dim coorString, cmdString As String
    Dim i As Integer
   
    offplineObj = plineObj.Offset(-0.1) '运行到这一步就直接跳出entrimf子过程返回enttrim
   
    offplineObj.Update
    Coors = offplineObj.Coordinates
    offplineObj.Delete
   
    coorString = ""
    For i = UBound(Coors) To UBound(Coors) Step 3
      coorString = coorString & Coors(i) & "," & Coors(i + 1) & "," & Coors(i + 2) & "," & vbCr
    Next i
    'coorString = Left(coorString, Len(coorString) - 1)
    cmdString = "trim" & vbCr & "(handent """ & plineObj.Handle & """)" & vbCr & _
                "f" & vbCr & coorString
    ThisDrawing.SendCommand cmdString
   

End Sub

今晚打老虎 发表于 2003-12-19 09:58:00

set offplineObj = plineObj.Offset(-0.1)

subtlation 发表于 2003-12-19 10:22:00

试过了，还是不行，我把dim offplineobj as acadentity 改为dim offplineobj就行了

今晚打老虎 发表于 2003-12-19 10:34:00

offset 返回的是对象的数组

Signature

RetVal = object.Offset(Distance)

RetVal

Variant (array of objects)
An array of the newly created objects resulting from the offset.

所以只能赋给变体了~~~

subtlation 发表于 2003-12-19 10:42:00

offset后，原来的对象删除了，我把程序改成这样，可是很奇怪的offplineobj.delete这句又不起作用。
Sub entTrim()
On Error Resume Next
Dim ent As AcadEntity
Dim pnt1 As Variant

ThisDrawing.Utility.GetEntity ent, pnt1, "选择多义线："
If Err Then Exit Sub
entTrimF ent
End Sub

Sub entTrimF(plineObj As AcadEntity)
    Dim offplineObj As Variant
    Dim Coors As Variant
    Dim coorString, cmdString As String
    Dim i As Integer
   
    Set offplineObj = plineObj.Copy
    offplineObj.Offset 0.1
    offplineObj.Update
    Coors = offplineObj.Coordinates
    offplineObj.Delete
end sub
   

今晚打老虎 发表于 2003-12-19 10:46:00

offplineObj 已经成为了一组对象了所以的改成这样offplineObj(0)

subtlation 发表于 2003-12-19 11:04:00

再请教一下，offset后原来的多义线还存在吗？下面的代码我在一个文件时运行时原来的多义线存在，但在另一个文件运行时原来的多义线不存在。是不是和某个系统变量有关？
Sub entTrimF(plineObj As AcadEntity)
    Dim offplineObj As Variant
    Dim Coors As Variant
    Dim coorString, cmdString As String
    Dim i As Integer
   
    offplineObj = plineObj.Offset(0.25)
    offplineObj(0).Update
   

subtlation 发表于 2003-12-19 11:11:00

帮忙在我的这个文件里运行一下以下代码，运行后原来的多义线位置会自动改变。
在运行代码前用zoom e
运行后在用一下zoom e

Sub entTrim()
On Error Resume Next
Dim ent As AcadEntity
Dim pnt1 As Variant

ThisDrawing.Utility.GetEntity ent, pnt1, "选择多义线："
If Err Then Exit Sub
entTrimF ent
End Sub
Sub entTrimF(plineObj As AcadEntity)
    Dim offplineObj As Variant
    Dim Coors As Variant
    Dim coorString, cmdString As String
    Dim i As Integer
   
    offplineObj = plineObj.Offset(0.25)
    offplineObj(0).Update
end sub

mccad 发表于 2003-12-19 11:59:00

这是个BUG，你查看以前的贴子，解决过这类问题。

subtlation 发表于 2003-12-19 14:15:00

谢谢明总，查到那个帖子了。先把要偏移的物体先复制一份，用复制的偏移，然后删除。

查看完整版本: [求助]谁帮我看看，为什么offset这一步运行下不去了