[求助]怎样创建填充图形
各位大侠 ：<p> 在ATUOLISP中用(command "solid" in_pk31 in_pk30 in_pk32 in_pk31 \)命令可以创建一个</p><p>三角填充图。</p><p>VBA中怎样实现此功能？</p><p>我用下面的命令，系统提示输入点无效</p><p>ThisDrawing.SendCommand "solid" & vbCr & "pick_point_first(0)" & vbCr & "point_arrow(0)" & vbCr & "point_arrow(1)" & vbCr & "pick_point_first(0)" & vbCr<br/></p><p>谢谢各位大侠帮忙</p> <p>CAD帮助文件中有这样的代码，稍做修改便可以满足要求：</p><p>Sub Example_AddHatch()<br/> ' This example creates an associative gradient hatch in model space.<br/> <br/> Dim hatchObj As AcadHatch<br/> Dim patternName As String<br/> Dim PatternType As Long<br/> Dim bAssociativity As Boolean<br/> <br/> <br/> patternName = "CYLINDER"<br/> PatternType = acPreDefinedGradient '0<br/> bAssociativity = True<br/> <br/> ' Create the associative Hatch object in model space<br/> Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity, acGradientObject)<br/> Dim col1 As AcadAcCmColor, col2 As AcadAcCmColor<br/> Set col1 = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")<br/> Set col2 = AcadApplication.GetInterfaceObject("AutoCAD.AcCmColor.16")<br/> Call col1.SetRGB(255, 0, 0)<br/> Call col2.SetRGB(0, 255, 0)<br/> hatchObj.GradientColor1 = col1<br/> hatchObj.GradientColor2 = col2<br/> <br/> ' Create the outer boundary for the hatch (a circle) 换成三角就可以了<br/> Dim outerLoop(0 To 0) As AcadEntity<br/> Dim center(0 To 2) As Double<br/> Dim radius As Double<br/> center(0) = 3: center(1) = 3: center(2) = 0<br/> radius = 1<br/> Set outerLoop(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)</p><p> ' Append the outerboundary to the hatch object, and display the hatch<br/> hatchObj.AppendOuterLoop (outerLoop)<br/> hatchObj.Evaluate<br/> ThisDrawing.Regen True<br/>End Sub</p>
页:
[1]