大师们请看看

yuangw1234

本人编了下面一个程式，就是选择很多物体一起偏移并删除以前的东西，但是会出现有些是内偏，而有些外偏，而如果是一个一个选，则都会外偏，请大师们过目并指教

Public Sub ttu()
Dim ssetobj1 As AcadSelectionSet
Dim icount1 As Integer

icount1 = ThisDrawing.SelectionSets.Count
While (icount1 > 0)
    If ThisDrawing.SelectionSets.Item(icount1 - 1).Name = "yuan" Then
    ThisDrawing.SelectionSets.Item(icount1 - 1).Delete
    End If
    icount1 = icount1 - 1
    Wend
    Set ssetobj1 = ThisDrawing.SelectionSets.Add("yuan")
    ThisDrawing.Utility.Prompt "please select object"
    ssetobj1.SelectOnScreen
   Dim i1 As Integer
   Dim selobj1 As Variant
   Dim shuz As Double
   shuz = ThisDrawing.Utility.GetReal("请输入偏移量 :")

  For i1 = 0 To ssetobj1.Count - 1
      Set selobj1 = ssetobj1.Item(i1)
      Dim ofselobj1 As Variant
     
     selobj1.Offset (shuz)
      selobj1.Delete

      Next

End Sub

 

雪山飞狐_lzh

[WEB]http://www.mccad.net/object/acad2004/idh_offset.htm[/WEB]