乐筑天下

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

将阴影区域添加到块。

[复制链接]

116

主题

996

帖子

9

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1466
发表于 2007-2-13 02:07:36 | 显示全部楼层 |阅读模式
有人能解释一下我在哪里吗;我做错了
我可以在模型空间中创建圆形阴影区域,但现在我想直接对块进行相同的绘制
一件奇怪的事情是,出于某种原因,circleObj需要是数组circleObj(0到0),否则它就不会't附加图案填充
这是代码I'到目前为止,我一直在写一个块:我得到一个编译错误,说can't分配给位置i#039处的数组;已显示。有解决方法吗。为什么它需要是一个数组
  1. Sub MakeBlock()
  2. Dim blockObj As AcadBlock
  3. Dim PatternType As Long
  4. Dim bAssociativity As Boolean
  5. Dim insertionPnt(0 To 2) As Double
  6.     insertionPnt(0) = 0
  7.     insertionPnt(1) = 0
  8.     insertionPnt(2) = 0
  9.     With AcadDoc
  10.         ' Define the block
  11.         Set blockObj = .Blocks.Add(insertionPnt, "CircleBlock")
  12.         ' Define the hatch
  13.         PatternType = 0
  14.         bAssociativity = True
  15.         HatchPattern = "SOLID"
  16.         ' Create the associative Hatch object in model space
  17.         Set hatchObj = blockObj.AddHatch(PatternType, HatchPattern, bAssociativity)
  18.         hatchObj.PatternScale = 1
  19.         ' Create the outer boundary for the hatch. (a circle)
  20.         Set circleObj = blockObj.AddCircle(Center, radius)   '<=============I get the error on this line
  21.         ' Append the outerboundary to the hatch object, and display the hatch
  22.         hatchObj.AppendOuterLoop (circleObj)
  23.         hatchObj.Evaluate
  24.         'Add Point
  25.         Dim pointObj As AcadPoint
  26.         Set pointObj = blockObj.AddPoint(insertionPnt)
  27.     End With
  28. End Sub
琼斯:添加了代码标记
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-2-13 06:17:11 | 显示全部楼层
您将circleObj定义为什么?
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-2-13 17:55:16 | 显示全部楼层
什么&#039;s变量#039;中心#039;定义为。。。?
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-2-13 19:09:33 | 显示全部楼层

同上&#039;半径#039;
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-2-13 20:42:56 | 显示全部楼层
只是为了澄清,块是非图形的,而块参照是您在图形中实际看到的
因此,定义和插入块引用应该是这样的(很抱歉,这一天太长了:
  1. Dim NewBlkName As String
  2. Dim InsertPt(0 To 2) As Double
  3. Dim xScale As Double
  4. Dim yScale As Double
  5. Dim zScale As Double
  6. Dim Rot As Double
  7. Dim objNewBlk As AcadBlockReference
  8. InsertPt(0) = something     'x coord
  9. InsertPt(1) = something     'y coord
  10. InsertPt(2) = something     'z coord
  11. xscale = some value
  12. yscale = some value
  13. zscale = some value
  14. Rot = some angle
  15. NewBlkName = "Some name and path to a drawing"
  16. Set objNewBlk = ThisDrawing.ModelSpace.InsertBlock(InsertPt, NewBlkName, xScale, yScale, zScale, Rot)
HTH
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-2-13 21:23:45 | 显示全部楼层
it#039;这是一个两步过程
1)dim oCircle作为acadcircle,然后添加tp块
2)dim varLoop(0)作为acadentity
设置varLoop(0)=oCircle
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-2-14 06:01:54 | 显示全部楼层
试一试,我使用了CopyObjects方法,Bryco在之前的帖子中在这个论坛的某个地方展示了这个方法,搜索一下它;J#039~
  1. Sub MakeBlock()
  2. Dim blockObj As AcadBlock
  3. Dim PatternType As Long
  4. Dim bAssociativity As Boolean
  5. Dim Radius As Double
  6. Radius = 1#
  7. Dim insertionPnt(0 To 2) As Double
  8.     insertionPnt(0) = 0
  9.     insertionPnt(1) = 0
  10.     insertionPnt(2) = 0
  11.     ' Define the block
  12.     Set blockObj = ThisDrawing.Blocks.Add(insertionPnt, "CircleBlock")
  13.    
  14.     With ThisDrawing.ModelSpace
  15.         ' Define the hatch
  16.         PatternType = 0
  17.         bAssociativity = True
  18.         HatchPattern = "SOLID"
  19.         ' Create the associative Hatch object in model space
  20.         Set hatchobj = .AddHatch(PatternType, HatchPattern, bAssociativity)
  21.         hatchobj.PatternScale = 1
  22.         Dim outerLoop(0) As AcadEntity
  23.         ' Create the outer boundary for the hatch. (a circle)
  24.         Set outerLoop(0) = .AddCircle(insertionPnt, Radius)
  25.         ' Append the outerboundary to the hatch object, and display the hatch
  26.         hatchobj.AppendOuterLoop (outerLoop)
  27.         hatchobj.Evaluate
  28.         'Add Point
  29.         Dim pointObj As AcadPoint
  30.         Set pointObj = .AddPoint(insertionPnt)
  31.         
  32.         End With
  33.         
  34.     ' The array of primary objects to be copied
  35.     Dim objCollection(0 To 1) As Object
  36.     Dim idPairs 'optional
  37.     ' fill array
  38.     Set objCollection(0) = hatchobj
  39.     Set objCollection(1) = pointObj
  40.     ' etc, etc
  41.     ' copy objects to block
  42.     ThisDrawing.CopyObjects objCollection, blockObj, idPairs
  43.    
  44. End Sub
回复

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-7-7 09:46 , Processed in 1.801417 second(s), 66 queries .

© 2020-2025 乐筑天下

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