乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 101|回复: 8

好像多数高手们都回家了,请教一个问题

[复制链接]

85

主题

1175

帖子

11

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1518
发表于 2004-1-18 19:53:00 | 显示全部楼层 |阅读模式
先祝各位早年愉快!
我想做一个将同一直线上的两条线段合并的程序,基本思路如下:
1.选择两个实体,如果是line或polyline则继续
2.将两条线段的四个端点分别赋值给pnt1,pnt2,pnt3,pnt4
3.将pnt1~4重新排列,使pnt1为x坐标最小的点,pnt4为x坐标最大的点.
4.若pnt1,pnt2的角度与pnt3,pnt4的角度相等,则说明四个点在一条直线上,继续.否则退出.
5.将第一个实体的两个端点分别设为pnt1和pnt4
6.删除第二个实体.结束
下面是部分未完成的代码:
Sub uniteline()
    Dim line1 As AcadEntity, line2 As AcadEntity
    Dim pnt1 As Variant, pnt2 As Variant, pnt3 As Variant, pnt4 As Variant, basepnt As Variant
choose1:
    ActiveDocument.Utility.GetEntity line1, basepnt, "选择第一根线段:"
    If line1.ObjectName = "AcDbLine" Then
       pnt1 = line1.StartPoint: pnt2 = line1.EndPoint
      Else
       GoTo choose1
    End If
choose2:
    ActiveDocument.Utility.GetEntity line2, basepnt, "选择第二根线段:"
    If line2.Handle = line1.Handle Then
       ActiveDocument.Utility.Prompt "线段二与线段一重复,请重新选择"
       GoTo choose2
     Else
    End If
    If line2.ObjectName = "AcDbLine" Then
       pnt3 = line2.StartPoint: pnt4 = line2.EndPoint
      Else
       GoTo choose1
    End If
    If pnt1(0) > pnt2(0) Then
       basepnt = pnt1
       pnt1 = pnt2
       pnt2 = basepnt
    End If
    If pnt1(0) > pnt3(0) Then
       basepnt = pnt1
       pnt1 = pnt3
       pnt3 = basepnt
    End If
    If pnt1(0) > pnt4(0) Then
       basepnt = pnt1
       pnt1 = pnt4
       pnt4 = basepnt
    End If
    If pnt4(0) < pnt3(0) Then
       basepnt = pnt4
       pnt4 = pnt3
       pnt3 = basepnt
    End If
    If pnt4(0) < pnt2(0) Then
       basepnt = pnt4
       pnt4 = pnt2
       pnt2 = basepnt
    End If
    If Abs(((pnt2(1) - pnt1(1)) / (pnt2(0) - pnt1(0))) - ((pnt4(1) - pnt3(1)) / (pnt4(0) - pnt3(0)))) < 0.000001 Then  '待改进
       line1.StartPoint = pnt1: line1.EndPoint = pnt4
       line2.Delete
     Else
       ActiveDocument.Utility.Prompt "线段一与线段二不在同一直线上,无法合并."
    End If
End Sub
执行过程中遇到几个问题:
1.由于不知道选择的是line还是polyline,所以将line1.line2定义为acadentity,但这样无法获得线段的startpoint和endpoint(但可以通过监视窗口看到),如果定义为acadline则可以获得其端点.
2.如何判断获得的polyline是直线还是曲线,包括多顶点的polyline.
3.如何在加载dvb时在命令行执行一个命令定义代码,如明总那个对齐程序,加载时执行(defun c:eo()(vl-vbarun "arrangeent")(princ))(princ)
回复

使用道具 举报

158

主题

2315

帖子

10

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2951
发表于 2004-1-18 21:27:00 | 显示全部楼层
1.只要图元是直线,就有StartPoint和EndPoint属性,不论其定义为AcadEntity或AcadLine,你也可以在
If line2.ObjectName = "AcDbLine" Then
后增加
Dim Line_2 as AcadLine
Set Line_2 = line2
来定义。
2.判断多段线的类型,可以使用多段线的Type属性,只有其值为acSimplePoly才为一般的多段线。
3.呵呵,你只要增加以下代码就行,利用的是EndCommand事件,看看我在那个程序中的源码吧:
  1. Public TestLoad As Boolean
  2. Private Sub AcadDocument_EndCommand(ByVal CommandName As String)
  3.     If Not TestLoad Then
  4.         ThisDrawing.SendCommand "(defun c:ao()(vl-vbarun ""alignent"")(princ))(princ)" & vbCr
  5.         ThisDrawing.SendCommand "(defun c:eo()(vl-vbarun ""arrangeent"")(princ))(princ)" & vbCr
  6.         TestLoad = True
  7.     End If
  8. End Sub
回复

使用道具 举报

85

主题

1175

帖子

11

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1518
发表于 2004-1-18 21:36:00 | 显示全部楼层
哇,老大,你终于来了
1.端点是有,在监视窗口也可以看到,但就是不能通过line1.startpoint来应用.而定义为acadline时就可以.另外你这个再定义一个acadline的方法我也试过,不能这样赋值.
2.acadpolyline没有startpoint和endpoint.
3.谢谢.
回复

使用道具 举报

158

主题

2315

帖子

10

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2951
发表于 2004-1-18 21:44:00 | 显示全部楼层
1.除非你的软件有问题,不然这种定义方法是完全可行的。
为了试验可行性,看看在你的程序中在取得两条线后位置添加以下代码:
    Dim l1 As AcadLine
    Dim l2 As AcadLine
    Set l1 = line1
    Set l2 = line2
2.多段线只有顶点坐标,而没有起点和终点之说,可以使用以下两个方法:
Coordinate 指定对象中单个顶点的坐标。
Coordinates 指定对象中每个顶点的坐标。
3.你只使用斜率来判断线是否在同一直线是的条件好象少了,需要再加些条件。如果两条平行线怎么办?
回复

使用道具 举报

85

主题

1175

帖子

11

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1518
发表于 2004-1-18 21:48:00 | 显示全部楼层
1.2.我再试试吧.明天晚上再汇报一下进展.
3.条件是不够,还在想其它办法.
回复

使用道具 举报

85

主题

1175

帖子

11

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1518
发表于 2004-1-19 19:59:00 | 显示全部楼层
1.可以了,我原来没用set
另外,acadpolyline,acadlwpolyline有什么不同?用vba画的在属性框看到的分别是2d/3d polyline 和 polyline ,在命令行用pl画的是polyline,好像2d/3d polyline是画不出的?
vba中能不能将多顶点polyline的某些顶点删除?
下面这个语句是不是错误?
if case1 then
   dim line1 as acadline
else
   dim line1 as acadlwpolyline
end if
回复

使用道具 举报

41

主题

657

帖子

9

银币

中流砥柱

Rank: 25

铜币
821
发表于 2004-1-19 20:20:00 | 显示全部楼层
没有必要删除顶点,用convert命令就可以将三维顶点的多段线改为二维多段线!
回复

使用道具 举报

14

主题

230

帖子

5

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
286
发表于 2004-1-20 08:20:00 | 显示全部楼层

这样会造成编译错误:当前范围内声明重复。
我认为可以这样解决:
Dim Line1 As Variant
If case1 Then
  ReDim Line1(0) As AcadLine
Else
  ReDim Line1(0) As AcadLWPolyline
End If
其中,ReDim语句常用于改变数组大小或类型。因此,变量Line1先声明为变体,然后根据条件重新声明为长度为1的ACAD对象数组。
回复

使用道具 举报

41

主题

657

帖子

9

银币

中流砥柱

Rank: 25

铜币
821
发表于 2004-1-23 14:42:00 | 显示全部楼层
李版主的这个方法很好~~
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-15 10:46 , Processed in 0.731326 second(s), 70 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表