找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 344|回复: 0

[VBA程序]:如果做交叉递增的圆点?

[复制链接]
发表于 2004-5-18 13:52:51 | 显示全部楼层 |阅读模式

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

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

×
我现在参照老大们的意思画出了递增的圆点,可还有点问题想请帮忙,能否帮我解决?


                               
登录/注册后可看大图


图中1.2.3.4是递增的圆点.

Option Explicit      
Public length, lengthn1, ptdis, mmaxr, mecha, n, p, q, l As Double
Public centerpt(0 To 2) As Double
Sub DengchaFen()

Dim radius, radius1 As Double
Dim lengthn As Integer
Dim circ As AcadCircle

If q = 0 Then
length = InputBox(":输入长度")
ptdis = InputBox("输入网点间距")
n = InputBox("输入绘制行数")
lengthn1 = length / (3 ^ (0.5) * ptdis)
p = 1
l = 1
End If
lengthn = Int(lengthn1)
radius = InputBox("输入最小点直径") / 2
radius1 = radius
mmaxr = InputBox("输入最大点直径") / 2
mecha = (mmaxr - radius) / lengthn


Do
    Do
         Set circ = ThisDrawing.ModelSpace.AddCircle(centerpt, radius)
         centerpt(0) = centerpt(0) + 3 ^ (0.5) * ptdis
         radius = radius + mecha
         q = q + 1
    Loop While centerpt(0) <= length
    centerpt(1) = centerpt(1) + ptdis
    centerpt(0) = 0
    radius = radius1
   
   
Loop While centerpt(1) <= (n * p - 1) * ptdis + ptdis / 4
   
dengcha.Show
ThisDrawing.Application.ZoomExtents
End Sub
我原来的代码做出来的效果如下

                               
登录/注册后可看大图

我希望能在画红处做出递增的圆点
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

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

GMT+8, 2024-11-23 04:30 , Processed in 0.174456 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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