设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › VBA、COM-ActiveX › [求助]：VBA中拉伸的问题。修改以前的贴子，节约论坛资 ...
返回列表 发新帖
查看: 717|回复: 2

[求助]：VBA中拉伸的问题。修改以前的贴子，节约论坛资源。6.11

[复制链接]
Springclock
发表于 2005-6-3 00:49:33 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
为了节约论坛资源，我修改以前的贴子。

  3.   [FONT=courier new]
  4. Sub Example_AddExtrudedSolidAlongPath()
  5.      di = Val(TextBox4.Text)
  6.      d0 = Val(TextBox5.Text)
  7.      W = Val(TextBox6.Text)
  8.      D = Val(TextBox7.Text)
  9.      H = Val(TextBox8.Text)
  10.      N = Val(TextBox9.Text)
  11.      L = Val(TextBox10.Text)
  12.      I = Val(TextBox11.Text)
  13.     ' This example extrudes a solid from a region
  14.     ' along a path defined by a spline.
  15.     ' The region is created from an arc and a line.
  16.    
  17.    
  18.    
  19.      ' This example creates a circle in model space.
  20.     Dim circleObj As AcadCircle
  21.     Dim centerPoint(0 To 2) As Double
  22.     Dim radius As Double
  23.    
  24.     ' Define the circle
  25.     centerPoint(0) = 500 * W - 1200 * D / (N + 1): centerPoint(1) = 500 * H + 500 * d0: centerPoint(2) = 500 * D - 1000 * D / (N + 1)
  26.     radius = 500 * d0
  27.    
  28.     ' Create the Circle object in model space
  29.     Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)

  31.     ' Define the rotation axis with two points
  32.     Dim rotatePt1(0 To 2) As Double
  33.     Dim rotatePt2(0 To 2) As Double
  34.     Dim rotateAngle As Double
  35.    
  36.     rotatePt1(0) = 500 * W - 1200 * D / (N + 1): rotatePt1(1) = 500 * H + 500 * d0: rotatePt1(2) = 500 * D - 1000 * D / (N + 1)
  37.     rotatePt2(0) = 500 * W - 1200 * D / (N + 1): rotatePt2(1) = 0: rotatePt2(2) = 500 * D - 1000 * D / (N + 1)
  38.     rotateAngle = 90
  39.     rotateAngle = rotateAngle * 3.141592 / 180
  40.    
  41.       
  42.     ' Rotate the Circle
  43.     circleObj.Rotate3D rotatePt1, rotatePt2, rotateAngle
  44.    
  45.    
  46.     ' Define the extrusion path (3DPolyline object)
  47.      Dim polyObj As Acad3DPolyline
  48.      Dim points(0 To 14) As Double

  50.     ' Define the 3D polyline points
  51.     points(0) = 500 * W - 1200 * D / (N + 1): points(1) = 500 * H + 500 * d0: points(2) = 500 * D - 1000 * D / (N + 1)
  52.     points(3) = -500 * W - 500 * d0: points(4) = 500 * H + 500 * d0: points(5) = 500 * D - 1000 * D / (N + 1)
  53.     points(6) = -500 * W - 500 * d0: points(7) = -500 * H - 500 * d0: points(8) = 500 * D - 1000 * D / (N + 1)
  54.     points(9) = 500 * W + 500 * d0: points(10) = -500 * H - 500 * d0: points(11) = 500 * D - 1000 * D / (N + 1)
  55.     points(12) = 500 * W + 500 * d0: points(13) = 500 * H - 1200 * D / (N + 1): points(14) = 500 * D - 1000 * D / (N + 1)
  56.    
  57.     ' Create a 3DPolyline in model space
  58.     Set polyObj = ThisDrawing.ModelSpace.Add3DPoly(points)
  59.     ' Create the solid
  60.    
  61.     Dim solidObj As Acad3DSolid
  62.     Set solidObj = ThisDrawing.ModelSpace.AddExtrudedSolidAlongPath(circleObj(0), polyObj)
  63.     ZoomAll
  64.    
  65. End Sub
  66.   [/FONT]


上面的代码运行到Set solidObj = ThisDrawing.ModelSpace.AddExtrudedSolidAlongPath(circleObj(0), polyObj)时出错，可以画出用来拉伸的的圆和拉伸的路径。其实我也知道上面的代码会有些错误，因为我删掉了一些我看不懂的代码。我想请教一下大家，把上面的代码补完整。谢谢啦。转到第三楼！

注：绘图时参考数据
蒸发器冷却排管围数：4
蒸发管外径：0.0065
冷冻室宽度：0.421
冷冻室深度：0.411
冷冻室高度：0.314
其他不用填
500, points, TextBox

相关帖子

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

使用道具 举报

雪山飞狐(lzh)
发表于 2005-6-3 09:17:49 | 显示全部楼层
用Rotate3D方法
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

Springclock
 楼主| 发表于 2005-6-3 11:39:59 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
我把里面看不懂的代码加进去。程序运行到Set curves(1) = ThisDrawing.ModelSpace.AddLine(curves(0).StartPoint, curves(0).EndPoint)
时停止。这些代码应该如何改呢？谢谢啦！

  3.   [FONT=courier new]
  4. Sub Example_AddExtrudedSolidAlongPath()
  5.      di = Val(TextBox4.Text)
  6.      d0 = Val(TextBox5.Text)
  7.      W = Val(TextBox6.Text)
  8.      D = Val(TextBox7.Text)
  9.      H = Val(TextBox8.Text)
  10.      N = Val(TextBox9.Text)
  11.      L = Val(TextBox10.Text)
  12.      I = Val(TextBox11.Text)
  13.     ' This example extrudes a solid from a region
  14.     ' along a path defined by a spline.
  15.     ' The region is created from an arc and a line.
  16.    
  17.    
  18.    
  19.      ' This example creates a circle in model space.
  20.     Dim circleObj As AcadCircle
  21.     Dim centerPoint(0 To 2) As Double
  22.     Dim radius As Double
  23.    
  24.     ' Define the circle
  25.     centerPoint(0) = 500 * W - 1200 * D / (N + 1): centerPoint(1) = 500 * H + 500 * d0: centerPoint(2) = 500 * D - 1000 * D / (N + 1)
  26.     radius = 500 * d0
  27.    
  28.     ' Create the Circle object in model space
  29.     Set circleObj = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)

  31.     ' Define the rotation axis with two points
  32.     Dim rotatePt1(0 To 2) As Double
  33.     Dim rotatePt2(0 To 2) As Double
  34.     Dim rotateAngle As Double
  35.    
  36.     rotatePt1(0) = 500 * W - 1200 * D / (N + 1): rotatePt1(1) = 500 * H + 500 * d0: rotatePt1(2) = 500 * D - 1000 * D / (N + 1)
  37.     rotatePt2(0) = 500 * W - 1200 * D / (N + 1): rotatePt2(1) = 0: rotatePt2(2) = 500 * D - 1000 * D / (N + 1)
  38.     rotateAngle = 90
  39.     rotateAngle = rotateAngle * 3.141592 / 180
  40.    
  41.       
  42.     ' Rotate the Circle
  43.     circleObj.Rotate3D rotatePt1, rotatePt2, rotateAngle
  44.    
  45.      Dim curves(0 To 1) As AcadEntity
  46.      
  47.      Set curves(0) = ThisDrawing.ModelSpace.AddCircle(centerPoint, radius)
  48.      Set curves(1) = ThisDrawing.ModelSpace.AddLine(curves(0).StartPoint, curves(0).EndPoint)
  49.      
  50.      ' Create the region
  51.      Dim regionObj As Variant
  52.      regionObj = ThisDrawing.ModelSpace.AddRegion(curves)
  53.    


  56.    
  57.     ' Define the extrusion path (3DPolyline object)
  58.      Dim polyObj As Acad3DPolyline
  59.      Dim points(0 To 14) As Double

  61.     ' Define the 3D polyline points
  62.     points(0) = 500 * W - 1200 * D / (N + 1): points(1) = 500 * H + 500 * d0: points(2) = 500 * D - 1000 * D / (N + 1)
  63.     points(3) = -500 * W - 500 * d0: points(4) = 500 * H + 500 * d0: points(5) = 500 * D - 1000 * D / (N + 1)
  64.     points(6) = -500 * W - 500 * d0: points(7) = -500 * H - 500 * d0: points(8) = 500 * D - 1000 * D / (N + 1)
  65.     points(9) = 500 * W + 500 * d0: points(10) = -500 * H - 500 * d0: points(11) = 500 * D - 1000 * D / (N + 1)
  66.     points(12) = 500 * W + 500 * d0: points(13) = 500 * H - 1200 * D / (N + 1): points(14) = 500 * D - 1000 * D / (N + 1)
  67.    
  68.     ' Create a 3DPolyline in model space
  69.     Set polyObj = ThisDrawing.ModelSpace.Add3DPoly(points)
  70.     ' Create the solid
  71.    
  72.     Dim solidObj As Acad3DSolid
  73.     Set solidObj = ThisDrawing.ModelSpace.AddExtrudedSolidAlongPath(regionObj(0), polyObj)
  74.     ZoomAll
  75.    
  76. End Sub
  77.   [/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

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

GMT+8, 2024-11-15 16:35 , Processed in 0.161019 second(s), 35 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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