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

subtlation

'运行到offset这一步就直接跳出entrimf子过程返回enttrim

2. Sub entTrim()
   
3.   On Error Resume Next
   
4.   Dim ent As AcadEntity
   
5.   Dim pnt1 As Variant
   
6.   
   
7.   ThisDrawing.Utility.GetEntity ent, pnt1, "选择多义线："
   
8.   If Err Then Exit Sub
   
9.   entTrimF ent
   
10. End Sub
    
11. 
    
12. Sub entTrimF(plineObj As AcadEntity)
    
13.     Dim offplineObj As AcadEntity
    
14.     Dim Coors As Variant
    
15.     Dim coorString, cmdString As String
    
16.     Dim i As Integer
    
17.    
    
18.     offplineObj = plineObj.Offset(-0.1) '运行到这一步就直接跳出entrimf子过程返回enttrim
    
19.    
    
20.     offplineObj.Update
    
21.     Coors = offplineObj.Coordinates
    
22.     offplineObj.Delete
    
23.    
    
24.     coorString = ""
    
25.     For i = UBound(Coors) To UBound(Coors) Step 3
    
26.       coorString = coorString & Coors(i) & "," & Coors(i + 1) & "," & Coors(i + 2) & "," & vbCr
    
27.     Next i
    
28.     'coorString = Left(coorString, Len(coorString) - 1)
    
29.     cmdString = "trim" & vbCr & "(handent """ & plineObj.Handle & """)" & vbCr & _
    
30.                 "f" & vbCr & coorString
    
31.     ThisDrawing.SendCommand cmdString
    
32.    
    
33. 
    
34. End Sub

Sub entTrim()<br />   On Error Resume Next<br />   Dim ent As AcadEntity<br />   Dim pnt1 As Variant<br />   <br />   ThisDrawing.Utility.GetEntity ent, pnt1, "选择多义线："<br />   If Err Then Exit Sub<br />   entTrimF ent<br /> End Sub<br /> <br /> Sub entTrimF(plineObj As AcadEntity)<br />     Dim offplineObj As AcadEntity<br />     Dim Coors As Variant<br />     Dim coorString, cmdString As String<br />     Dim i As Integer<br />     <br />     offplineObj = plineObj.Offset(-0.1) '运行到这一步就直接跳出entrimf子过程返回enttrim<br />     <br />     offplineObj.Update<br />     Coors = offplineObj.Coordinates<br />     offplineObj.Delete<br />     <br />     coorString = ""<br />     For i = UBound(Coors) To UBound(Coors) Step 3<br />       coorString = coorString & Coors(i) & "," & Coors(i + 1) & "," & Coors(i + 2) & "," & vbCr<br />     Next i<br />     'coorString = Left(coorString, Len(coorString) - 1)<br />     cmdString = "trim" & vbCr & "(handent """ & plineObj.Handle & """)" & vbCr & _<br />                 "f" & vbCr & coorString<br />     ThisDrawing.SendCommand cmdString<br />     <br /> <br /> End Sub

今晚打老虎

set offplineObj = plineObj.Offset(-0.1)

subtlation

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

今晚打老虎

offset 返回的是对象的数组

Signature

RetVal = object.Offset(Distance)

RetVal

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

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

subtlation

offset后，原来的对象删除了，我把程序改成这样，可是很奇怪的offplineobj.delete这句又不起作用。

2. Sub entTrim()
   
3.   On Error Resume Next
   
4.   Dim ent As AcadEntity
   
5.   Dim pnt1 As Variant
   
6.   
   
7.   ThisDrawing.Utility.GetEntity ent, pnt1, "选择多义线："
   
8.   If Err Then Exit Sub
   
9.   entTrimF ent
   
10. End Sub
    
11. 
    
12. Sub entTrimF(plineObj As AcadEntity)
    
13.     Dim offplineObj As Variant
    
14.     Dim Coors As Variant
    
15.     Dim coorString, cmdString As String
    
16.     Dim i As Integer
    
17.    
    
18.     Set offplineObj = plineObj.Copy
    
19.     offplineObj.Offset 0.1
    
20.     offplineObj.Update
    
21.     Coors = offplineObj.Coordinates
    
22.     offplineObj.Delete
    
23. end sub  
    
24.    
    

Sub entTrim()<br />   On Error Resume Next<br />   Dim ent As AcadEntity<br />   Dim pnt1 As Variant<br />   <br />   ThisDrawing.Utility.GetEntity ent, pnt1, "选择多义线："<br />   If Err Then Exit Sub<br />   entTrimF ent<br /> End Sub<br /> <br /> Sub entTrimF(plineObj As AcadEntity)<br />     Dim offplineObj As Variant<br />     Dim Coors As Variant<br />     Dim coorString, cmdString As String<br />     Dim i As Integer<br />     <br />     Set offplineObj = plineObj.Copy<br />     offplineObj.Offset 0.1<br />     offplineObj.Update<br />     Coors = offplineObj.Coordinates<br />     offplineObj.Delete<br /> end sub  <br />     <br />

今晚打老虎

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

subtlation

再请教一下，offset后原来的多义线还存在吗？下面的代码我在一个文件时运行时原来的多义线存在，但在另一个文件运行时原来的多义线不存在。是不是和某个系统变量有关？

2. Sub entTrimF(plineObj As AcadEntity)
   
3.     Dim offplineObj As Variant
   
4.     Dim Coors As Variant
   
5.     Dim coorString, cmdString As String
   
6.     Dim i As Integer
   
7.    
   
8.     offplineObj = plineObj.Offset(0.25)
   
9.     offplineObj(0).Update
   
10.    

Sub entTrimF(plineObj As AcadEntity)<br />     Dim offplineObj As Variant<br />     Dim Coors As Variant<br />     Dim coorString, cmdString As String<br />     Dim i As Integer<br />     <br />     offplineObj = plineObj.Offset(0.25)<br />     offplineObj(0).Update<br />    

subtlation

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

2. Sub entTrim()
   
3.   On Error Resume Next
   
4.   Dim ent As AcadEntity
   
5.   Dim pnt1 As Variant
   
6.   
   
7.   ThisDrawing.Utility.GetEntity ent, pnt1, "选择多义线："
   
8.   If Err Then Exit Sub
   
9.   entTrimF ent
   
10. End Sub
    
11. Sub entTrimF(plineObj As AcadEntity)
    
12.     Dim offplineObj As Variant
    
13.     Dim Coors As Variant
    
14.     Dim coorString, cmdString As String
    
15.     Dim i As Integer
    
16.    
    
17.     offplineObj = plineObj.Offset(0.25)
    
18.     offplineObj(0).Update
    
19. end sub
    

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

mccad

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

subtlation

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