linlq986 发表于 2011-7-28 12:29:30

帮我补一下代码，把选定的内容中，用二维多段线替换绿色的直线

本帖最后由 linlq986 于 2011-7-30 18:05 编辑

可能是问题没说清楚？！
程序目的：
1，在选择集中判断出哪些是绿色的直线
2，取得直线的坐标
3，删除直线，
4，用取得的坐标画多线段

Sub 加加()
Dim sset As AcadSelectionSet '定义选择集对象
Dim v As AcadEntity '定义选择集中的元素对象

Set sset = ThisDrawing.SelectionSets.Add("ss11") '新建一个选择集
Call sset.Select(acSelectionSetPrevious)'提示用户选择
For Each v In sset '在选择集中进行循环
    If v.color = acGreen and v.EntityName ="AcadLWPolyline" Then’ 直线好像不是AcadLWPolyline？
      ‘取得直线的x，y坐标，这个不懂
      Set lobj = ThisDrawing.ModelSpace.AddSpline(u1,u2, u2)'直线的x，y坐标画二维多段线
      v.delete'删除直线
    End If
Next
p1 = ThisDrawing.Utility.GetPoint(, "输入点:") ’获取点坐标
‘输入文字“更入了N条多段线”
sset.Delete '删除选择集
End Sub

linlq986 发表于 2011-7-28 21:12:38

本帖最后由 linlq986 于 2011-7-28 21:13 编辑

自己边学边改
Sub 加加()
Dim sset As AcadSelectionSet '定义选择集对象
Dim v As AcadEntity '定义选择集中的元素对象


Set sset = ThisDrawing.SelectionSets.Add("ss11") '新建一个选择集
Call sset.Select(acSelectionSetPrevious)'提示用户选择
For Each v In sset '在选择集中进行循环
    If v.color = acGreen and v.EntityName ="AcadLWPolyline" Then’ 直线好像不是AcadLWPolyline？
      ‘取得直线的x，y坐标，这个不懂
      Set lobj = ThisDrawing.ModelSpace.AddSpline(u1,u2, u2)'直线的x，y坐标画二维多段线
      v.delete'删除直线
      条数=条数+1
    End If
Next
p1 = ThisDrawing.Utility.GetPoint(, "输入点:") ’获取点坐标
Call ThisDrawing.ModelSpace.AddMText(p1, 35, “更换了" + 条数+ “条多段线”）‘今天学会了这一句
sset.Delete '删除选择集
End Sub

linlq986 发表于 2011-7-30 18:06:07

应该不是很难吧，哪位大虾帮一下

还是较习惯在excel上用vba

linlq986 发表于 2011-7-30 19:44:30

解决了，另类的方法

老板另招了一个小家伙，我把画多段线覆盖直线这种事让给他了

wwswwswws 发表于 2011-9-20 10:05:23

哈哈，你这个方法真的很另类！

Sub 加加()
Dim sset As AcadSelectionSet '定义选择集对象
Dim v As AcadEntity '定义选择集中的元素对象
Dim 条数 as long
Dim pPL(5) as double
Dim plObj As AcadPolyline

Set sset = ThisDrawing.SelectionSets.Add("ss11") '新建一个选择集
Call sset.Select(acSelectionSetPrevious)'提示用户选择
For Each v In sset '在选择集中进行循环
    If v.color = acGreen and v.EntityName ="AcadLine" Then’
   ‘取得直线的x，y坐标，这个不懂
    ppointstart(0)=v.startpoint(0)
    ppointstart(1)=v.startpoint(1)
    pPointend(0)=v.endpoint(0)
    pPointend(1)=v.endpoint(1)
    ppl(0)=v.startpoint(0):ppl(1)=v.startpoint(1):ppl(2)=0
    ppl(3)=v.endpoint(0):ppl(4)=v.endpoint(1):ppl(5)=0
      Set Plobj = ThisDrawing.ModelSpace.AddPolyline(pPl)'直线的x，y坐标画二维多段线
      v.delete'删除直线
      条数=条数+1
    End If
Next
p1 = ThisDrawing.Utility.GetPoint(, "输入点:") ’获取点坐标
Call ThisDrawing.ModelSpace.AddMText(p1, 35, “更换了" + 条数+ “条多段线”）‘今天学会了这一句
sset.Clear
sset.Delete '删除选择集
End Sub

大概就是这样的

wwswwswws 发表于 2011-9-20 10:06:28

上面pPointStart和pPointEnd忘删了
页: [1]
查看完整版本: 帮我补一下代码，把选定的内容中，用二维多段线替换绿色的直线