home 发表于 2008-4-17 21:54:00

自动填充的，出错了，帮忙看看！！

<p>Sub test()<br/>&nbsp;&nbsp;&nbsp; Dim hatchObj As AcadHatch<br/>&nbsp;&nbsp;&nbsp; Dim patternName As String<br/>&nbsp;&nbsp;&nbsp; Dim PatternType As Long<br/>&nbsp;&nbsp;&nbsp; Dim bAssociativity As Boolean<br/>&nbsp;&nbsp;&nbsp; Dim outerLoop(0 To 0) As AcadEntity</p><p>&nbsp;&nbsp;&nbsp; ' 定义图案填充<br/>&nbsp;&nbsp;&nbsp; patternName = "ANSI31"<br/>&nbsp;&nbsp;&nbsp; PatternType = 0<br/>&nbsp;&nbsp;&nbsp; bAssociativity = True</p><p>&nbsp;&nbsp;&nbsp; ' 当前图纸的实体数目<br/>&nbsp;&nbsp;&nbsp; Dim n As Long<br/>&nbsp;&nbsp;&nbsp; n = ThisDrawing.ModelSpace.Count<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; ' 调用BOUNDARY命令获取某一点处的边界<br/>&nbsp;&nbsp;&nbsp; Dim Pt As Variant<br/>&nbsp;&nbsp;&nbsp; Pt = ThisDrawing.Utility.GetPoint(, "指定内部点: ")<br/>&nbsp;&nbsp;&nbsp; ThisDrawing.SendCommand "_-Boundary" &amp; vbCr &amp; Pt(0) &amp; "," &amp; Pt(1) &amp; vbCr &amp; vbCr<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; ' 如果存在边界，则会生成新的实体<br/>&nbsp;&nbsp;&nbsp; Dim lwpLineObj As AcadLWPolyline<br/>&nbsp;&nbsp;&nbsp; If ThisDrawing.ModelSpace.Count &gt; n Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Set lwpLineObj = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox lwpLineObj.Area<br/>'&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; lwpLineObj.Delete<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; lwpLineObj.Closed = True<br/>&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; MsgBox "未发现有效的边界。"<br/>&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp; outerLoop(0) = lwpLineObj<br/>&nbsp;&nbsp;&nbsp; hatchObj.AppendOuterLoop (outerLoop)<br/>&nbsp;&nbsp;&nbsp; hatchObj.Evaluate<br/>&nbsp;&nbsp;&nbsp; ObjDoc.Regen True<br/>End Sub</p>

home 发表于 2008-5-8 12:37:00

<p>解决了，</p><p>需要加Boundary命令前加个zoomall命令</p>

muzi2005888 发表于 2008-5-9 18:47:00

<p>我想楼主个问题</p><p>在对面域填充时</p><p>当面域为不连续或为环状时则不能正常填充（利用快速选择能选中图案填充，就是不能显示）</p>

nhy12345678 发表于 2008-5-9 19:14:00

Dim i As Long<br/>Dim hatchObj As AcadHatch<br/>Dim patternName As String<br/>Dim patternType As Long<br/>Dim assocVar As Boolean<br/>Dim outerLoop(0 To 0) As AcadEntity<br/>Dim eNt As AcadEntity<br/>Dim sset As AcadSelectionSet<br/>Dim outerLoop1(0 To 0) As AcadEntity<br/>Dim n As Long<br/>Dim Pt As Variant<br/>patternName = "SOLID"<br/>patternType = acHatchPatternTypePreDefined<br/>assocVar = True<br/>n = ThisDrawing.ModelSpace.Count<br/>Pt = ThisDrawing.Utility.GetPoint(, "指定内部点: ")<br/>ThisDrawing.SendCommand "_-Boundary" &amp; vbCr &amp; Pt(0) &amp; "," &amp; Pt(1) &amp; vbCr &amp; vbCr<br/>If ThisDrawing.ModelSpace.Count &gt; n Then<br/>&nbsp;&nbsp; Set outerLoop1(0) = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)<br/>Else<br/>&nbsp;&nbsp; MsgBox "未发现有效的边界。"<br/>End If<br/>&nbsp;Set sset = ThisDrawing.SelectionSets.Add("ss7")<br/>&nbsp;sset.AddItems outerLoop1<br/>For Each eNt In sset<br/>&nbsp;&nbsp; Set outerLoop(0) = eNt<br/>&nbsp;&nbsp; Set hatchObj = ThisDrawing.ModelSpace.AddHatch(patternType, patternName, assocVar)<br/>&nbsp;&nbsp; hatchObj.AppendOuterLoop (outerLoop)<br/>&nbsp;&nbsp; hatchObj.Evaluate<br/>Next<br/>sset.Delete<br/>ThisDrawing.Regen True
页: [1]
查看完整版本: 自动填充的，出错了，帮忙看看！！