线不能串连

yuangw1234

本人这样写了一个将线串连的程式，可是不能串连

请大师指教，希望可以帮忙修改一下，谢谢

Public Sub j()
Dim obj As AcadEntity, pt As Variant, selobj As AcadEntity, ssetobj As AcadSelectionSet
ThisDrawing.Utility.GetEntity obj, pt: obj.Highlight True
On Error Resume Next
ThisDrawing.SelectionSets("j").Delete
Err.Clear
Set ssetobj = ThisDrawing.SelectionSets.Add("j")
Dim cmd As String
cmd = "pe" & vbCr & obj & "j" & vbCr & ssetobj & vbCr
ThisDrawing.SendCommand cmd
End Sub

xinghesnak

实体和选择集怎么能作为命令行中的东东出现呢？可能得用LISP了，会LISP的高手帮帮忙吧。。。。。

yuangw1234

但是vba應該也是可以做的啊，版主能否指教本人一二，谢谢！

login1986

好像很復杂!!!

xinghesnak

没有高手出面，自立更生啦，看下面的程序吧！

Sub main()
Dim obj As AcadEntity, pt As Variant, selobj As AcadEntity, ssetobj As AcadSelectionSet
ThisDrawing.Utility.GetEntity obj, pt: obj.Highlight True
On Error Resume Next
ThisDrawing.SelectionSets("j").Delete
Err.Clear
Set ssetobj = ThisDrawing.SelectionSets.Add("j")
ssetobj.SelectOnScreen

Dim cmd As String
cmd = "pe" & vbCr & "(handent """ & obj.Handle & """)" & vbCr & "j" & vbCr
Dim i As Integer
For i = 0 To ssetobj.Count
    cmd = cmd & "(handent """ & ssetobj.Item(i).Handle & """)" & vbCr
Next

ThisDrawing.SendCommand cmd & vbCr & vbCr
End Sub

yuangw1234

兄台，不行的，我用过，并没有串连，管理员可以帮忙吗

xinghesnak

在我这运行没有问题，报错吗？

yuangw1234

是选过后没有串连

xinghesnak

我先选一个pline线，再选中3，4根Line，没有问题，要不你把你的图传上来睽睽吧！

yuangw1234

Public Sub j()
Dim ssetobj As AcadSelectionSet
On Error Resume Next
ThisDrawing.SelectionSets("j").Delete
Err.Clear
Set ssetobj = ThisDrawing.SelectionSets.Add("j")
ssetobj.SelectOnScreen
Dim cmd As String
cmd = "pe" & vbCr & "m" & vbCr & "p" & vbCr & vbCr & "y" & vbCr & "j" & vbCr & vbCr & vbCr
ThisDrawing.SendCommand cmd
End Sub