worker 发表于 2006-12-8 02:18:00

VBA创建图块的问题,我已经努力了,但做不到

<P>谁能帮助我一下?熬3天了,坚持不住了,</P>
<P>问题是:</P>
<P>怎样用一个选择集创建一个图块,</P>

worker 发表于 2006-12-8 08:43:00

<P>&nbsp;</P>人呢?都哪里去了?

weihedao 发表于 2007-5-28 20:24:00

<p>&nbsp;&nbsp; Dim sset As AcadSelectionSet&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.SelectionSets.Item("path").Delete<br/>&nbsp;&nbsp;&nbsp; Set sset = ThisDrawing.SelectionSets.Add("path")<br/>&nbsp;&nbsp;&nbsp; Dim objs() As AcadEntity<br/>&nbsp;&nbsp;&nbsp; Dim zhongzhuan As Double<br/>&nbsp;&nbsp;&nbsp; Dim Entity As AcadEntity<br/>&nbsp;&nbsp; sset.SelectOnScreen '在屏幕上面选线段<br/>&nbsp;&nbsp; <br/>&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; For Each Entity In sset '如果块已经定义则不需要重新定义<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Entity.ObjectName = "AcDbBlockReference" Then '"AcDbBlockBegin"blockReference<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Entity.Name = "sleeper" Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set blockRefObj = Entity.Copy()<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox "wwww"<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; GoTo insertkuai<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp; <br/>&nbsp;&nbsp; End</p><p>&nbsp;&nbsp;&nbsp; Dim insertionPnt As Variant<br/>&nbsp;<br/>&nbsp;&nbsp;&nbsp; insertionPnt = ThisDrawing.Utility.GetPoint(, "拾取块的中点")</p><p><br/>&nbsp;&nbsp;&nbsp; Set blockObj = ThisDrawing.Blocks.Add _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (insertionPnt, "sleeper")<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For Each element In blockObj<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; element.Delete<br/>&nbsp;&nbsp;&nbsp;&nbsp; Next<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp; <br/>&nbsp; </p><p>&nbsp;&nbsp;&nbsp;&nbsp; ReDim objs(sset.Count - 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp; Dim i<br/>&nbsp;&nbsp;&nbsp;&nbsp; For i = 0 To sset.Count - 1<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set objs(i) = sset(i)<br/>&nbsp;&nbsp;&nbsp;&nbsp; Next i<br/>&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; ThisDrawing.CopyObjects objs, blockObj&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; </p><p>&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp; Set blockRefObj = ThisDrawing.ModelSpace.InsertBlock _<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (insertionPnt, "sleeper", 1#, 1#, 1#, 0)</p>
页: [1]
查看完整版本: VBA创建图块的问题,我已经努力了,但做不到