slysmart 发表于 2021-8-24 10:43:17

求助，移动图纸

我这个写法不能执行，问题在什么地方？谢谢
Set acDoc = acadapp.documents.open(TempPath,False) '打开图纸，这步没问题
    Dim SSet As AcadSelectionSet
    Set SSet = acDoc.SelectionSets.add("SSET")
    CALL SSet.Select(acSelectionSetAll)
    Dim E As AcadEntity
    For Each E In SSet
      E.move "-500,-500" , "0,0"
    Next





mikewolf2k 发表于 2021-8-24 14:37:03

错在哪里，E是什么?

bluelover 发表于 2021-8-24 15:11:25

本帖最后由 bluelover 于 2021-8-24 17:25 编辑

你这段有好几个问题。
1）建议用安全创建选择集的方法,要不然重复运行时会因为SSET存在而无法创建。
On Error Resume Next
Dim SSet As AcadSelectionSet
If Not IsNull(acDoc.SelectionSets.Item("SSET")) Then
Set SSet = acDoc.SelectionSets.Item("SSET")
SSET.Clear
SSet.Delete
End If
Set SSet = acDoc.SelectionSets.Add("SSET")
on error goto 0

2） move 的使用方法是 .MOVE PT1，PT2
DIM PT1(2) AS DOUBLE
DIM PT2(2) AS DOUBLE

PT1(0)=-500
PT1(1)=-500
PT2(0)=0
PT2(1)=0

3) 试试 如下方法
SSet.Select acSelectionSetAll
if SSet.count>0
    dim Ent as AcadEntity, i as integer   
   for i=0 to sset.count-1
   set Ent= SSet.item(i)
      Ent.move PT1,PT2
   next
end if






slysmart 发表于 2021-8-24 16:15:52

bluelover 发表于 2021-8-24 15:11
你这段有好几个问题。
1）建议用安全创建选择集的方法,要不然重复运行时会因为SSET存在而无法创建。
On E ...

非常感谢:handshake
页: [1]
查看完整版本: 求助，移动图纸