我正在尝试帮助一位朋友使用此代码 ;他们可以使用2个拾取的点绘制德克萨斯州的国旗,但希望在结果中做出一个区块 ;我想不出来
-
- Option Explicit
- Public Sub DrawTexasFlagOp()
- Dim PT1 As Variant
- Dim PT2 As Variant
- Dim pntLL(0 To 2) As Double
- Dim pntLR(0 To 2) As Double
- Dim pntUL(0 To 2) As Double
- Dim pntUR(0 To 2) As Double
- Dim pntLRBlue(0 To 2) As Double
- Dim pntURBlue(0 To 2) As Double
- Dim vertDist As Double
- Dim horzDist As Double
- Dim pntRW_Left(0 To 2) As Double
- Dim pntRW_Right(0 To 2) As Double
- Dim circleDiameter As Double
- Dim cntPnt(0 To 2) As Double
- Dim cir As AcadCircle
- Dim starTopPoint(0 To 2) As Double
- ' star leg length @ unit circle of 1 = .7265
- ' starlegLength is variable
- Dim starLegLen As Double
- Dim starLegStart As Variant
- Dim starLegEnd As Variant
- PT1 = ThisDrawing.Utility.GetPoint(, "Pick lower left corner of Flag")
- vertDist = ThisDrawing.Utility.GetDistance(PT1, vbCr & "Pick distance for vertical")
- horzDist = (vertDist / 2) * 3
- pntLL(0) = PT1(0) 'X value
- pntLL(1) = PT1(1) 'Y value
- pntUL(0) = PT1(0)
- pntUL(1) = PT1(1) + vertDist
- pntLR(0) = PT1(0) + horzDist
- pntLR(1) = PT1(1)
- pntUR(0) = PT1(0) + horzDist
- pntUR(1) = PT1(1) + vertDist
- pntLRBlue(0) = pntLL(0) + (horzDist / 3)
- pntLRBlue(1) = pntLL(1)
- pntURBlue(0) = pntLL(0) + (horzDist / 3)
- pntURBlue(1) = pntLL(1) + vertDist
- pntRW_Left(0) = pntLRBlue(0)
- pntRW_Left(1) = pntLRBlue(1) + (vertDist / 2)
- pntRW_Right(0) = pntLR(0)
- pntRW_Right(1) = pntRW_Left(1)
- circleDiameter = (horzDist / 3) * 0.75
- cntPnt(0) = pntLL(0) + horzDist / 6
- cntPnt(1) = pntLL(1) + vertDist / 2
- starTopPoint(0) = cntPnt(0)
- starTopPoint(1) = cntPnt(1) + (circleDiameter / 2)
- starLegLen = 0.7265 * (circleDiameter / 2)
- Dim plineObjStar As AcadLWPolyline
- Dim pointsStar(0 To 21) As Double
- starLegStart = starTopPoint
- starLegEnd = ThisDrawing.Utility.PolarPoint(starLegStart, dtor(288), starLegLen)
- pointsStar(0) = starTopPoint(0)
- pointsStar(1) = starTopPoint(1)
- pointsStar(2) = starLegEnd(0)
- pointsStar(3) = starLegEnd(1)
- starLegStart = starLegEnd
- starLegEnd = ThisDrawing.Utility.PolarPoint(starLegStart, dtor(0), starLegLen)
- pointsStar(4) = starLegEnd(0)
- pointsStar(5) = starLegEnd(1)
- starLegStart = starLegEnd
- starLegEnd = ThisDrawing.Utility.PolarPoint(starLegStart, dtor(216), starLegLen)
- pointsStar(6) = starLegEnd(0)
- pointsStar(7) = starLegEnd(1)
- starLegStart = starLegEnd
- starLegEnd = ThisDrawing.Utility.PolarPoint(starLegStart, dtor(288), starLegLen)
- pointsStar(8) = starLegEnd(0)
- pointsStar(9) = starLegEnd(1)
- starLegStart = starLegEnd
- starLegEnd = ThisDrawing.Utility.PolarPoint(starLegStart, dtor(144), starLegLen)
- pointsStar(10) = starLegEnd(0)
- pointsStar(11) = starLegEnd(1)
- starLegStart = starLegEnd
- starLegEnd = ThisDrawing.Utility.PolarPoint(starLegStart, dtor(216), starLegLen)
- pointsStar(12) = starLegEnd(0)
- pointsStar(13) = starLegEnd(1)
- starLegStart = starLegEnd
- starLegEnd = ThisDrawing.Utility.PolarPoint(starLegStart, dtor(72), starLegLen)
- pointsStar(14) = starLegEnd(0)
- pointsStar(15) = starLegEnd(1)
- starLegStart = starLegEnd
- starLegEnd = ThisDrawing.Utility.PolarPoint(starLegStart, dtor(144), starLegLen)
- pointsStar(16) = starLegEnd(0)
- pointsStar(17) = starLegEnd(1)
- starLegStart = starLegEnd
- starLegEnd = ThisDrawing.Utility.PolarPoint(starLegStart, dtor(0), starLegLen)
- pointsStar(18) = starLegEnd(0)
- pointsStar(19) = starLegEnd(1)
- pointsStar(20) = starTopPoint(0)
- pointsStar(21) = starTopPoint(1)
- Dim mylayer As AcadLayer
- Set mylayer = ThisDrawing.Layers.Add("RED")
- mylayer.color = acRed
- Set mylayer = ThisDrawing.Layers.Add("WHITE")
- mylayer.color = acWhite
- Set mylayer = ThisDrawing.Layers.Add("BLUE")
- mylayer.color = acBlue
- Set mylayer = ThisDrawing.Layers.Item("RED")
- ThisDrawing.ActiveLayer = ThisDrawing.Layers.Item("0")
- Dim hatchObj As AcadHatch
- Dim hatchObj2 As AcadHatch
- Dim hatchObj3 As AcadHatch ' blue
- Dim hatchobj4 As AcadHatch
- Dim patternName As String
- Dim PatternType As Long
- Dim bAssociativity As Boolean
- ' Define the hatch
- patternName = "SOLID"
- PatternType = 0
- bAssociativity = True
- Set hatchObj = ThisDrawing.ModelSpace.AddHatch(PatternType, patternName, bAssociativity)
- Dim plineObj As AcadLWPolyline
- Dim points(0 To 9) As Double
- points(0) = pntRW_Left(0)
- points(1) = pntRW_Left(1)
- points(2) = pntRW_Right(0)
|