找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 776|回复: 7

[编程申请]:块等距分布

[复制链接]
发表于 2002-11-18 10:42:26 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
现在几个块在一条直线上,但是块与块之间的距离不相等
申请:
点选第一个初始块,再点击最后一个末块,然后选中这几个块后,这几个快能以第一个块为始,最后一个块为终等距离分布
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
 楼主| 发表于 2002-11-18 10:46:37 | 显示全部楼层
最终效果
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2002-11-18 10:51:01 | 显示全部楼层
命令divide有等距分布图块的功能,不知道它是否满足你的要求。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 181个

财富等级: 日进斗金

发表于 2002-11-18 11:07:54 | 显示全部楼层
Divide命令仅对线类有用吧。
下面的程序应该可以实现。

  1.   [FONT=courier new]

  2. Sub DivideBlock()
  3.     On Error GoTo ErrTrap
  4.     Dim StartEntObj As AcadEntity
  5.     Dim pPt As Variant
  6.     ThisDrawing.Utility.GetEntity StartEntObj, pPt, "请选择第一个对象: "
  7.     Dim EndEntObj As AcadEntity
  8.     ThisDrawing.Utility.GetEntity EndEntObj, pPt, "请选择最后一个对象: "
  9.     If StartEntObj.ObjectName <> "AcDbBlockReference" Or StartEntObj.ObjectName <> EndEntObj.ObjectName Then
  10.         ThisDrawing.Utility.Prompt "您选择的不是块! "
  11.         Exit Sub
  12.     End If
  13.     Dim SSetObj As AcadSelectionSet
  14.     Set SSetObj = ThisDrawing.SelectionSets.Add("DivideBlock")
  15.     SSetObj.SelectOnScreen
  16.     If SSetObj.Count = 0 Then Exit Sub
  17.     '计算块与块之间的间距
  18.     Dim Dist As Double
  19.     Dist = CalcDistance(StartEntObj.InsertionPoint, EndEntObj.InsertionPoint) / (SSetObj.Count + 1)
  20.     '计算块分布的角度
  21.     Dim Ang As Double
  22.     Ang = ThisDrawing.Utility.AngleFromXAxis(StartEntObj.InsertionPoint, EndEntObj.InsertionPoint)
  23.     Dim i As Integer
  24.     For i = 0 To SSetObj.Count - 1
  25.         SSetObj(i).InsertionPoint = ThisDrawing.Utility.PolarPoint(StartEntObj.InsertionPoint, Ang, Dist * (i + 1))
  26.     Next
  27.     SSetObj.Delete
  28.     Set SSetObj = Nothing
  29.     Exit Sub
  30. ErrTrap:
  31.     If ThisDrawing.GetVariable("errno") = 7 Then Resume
  32.     On Error GoTo 0
  33. End Sub

  34. '计算距离
  35. Public Function CalcDistance(ByVal Pt1 As Variant, Optional ByVal Pt2 As Variant) As Double
  36.     CalcDistance = 0
  37.     Dim dX As Double
  38.     Dim dY As Double
  39.     Dim dZ As Double
  40.    
  41.     On Error GoTo ErrTrap
  42.     dX = Pt2(0) - Pt1(0)
  43.     dY = Pt2(1) - Pt1(1)
  44.     dZ = Pt2(2) - Pt1(2)
  45.     CalcDistance = Sqr(dX ^ 2 + dY ^ 2 + dY ^ 2)
  46.     Exit Function

  47. ErrTrap:
  48.     On Error GoTo 0
  49. End Function

  50.   [/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2002-11-18 11:31:32 | 显示全部楼层

回efan2000兄

divide命令是沿着指定对象等距排列点或块,指定对象必须是线性的,如直线、圆弧、多段线、样条线等,但排列的对象可以是非线性的,如点、图块等。我没明白efan2000兄指的“仅对线类有用”是什么,望商榷!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2002-11-18 11:46:37 | 显示全部楼层
我明白YI.GAO的等分块的意思,不过会麻烦点,况且已经有的块不想删除掉了:)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 181个

财富等级: 日进斗金

发表于 2002-11-18 11:49:52 | 显示全部楼层
就是说必须要首先指定线类的对象,然后对其等分,并根据等分后的点的位置进行操作,所以实现步骤繁长。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2002-11-18 12:06:01 | 显示全部楼层
说得对,现在就是想避开繁琐和线性的限制,根据初始块和末块实现块间距等分:)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-12-26 15:17 , Processed in 0.542527 second(s), 47 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表