[编程交流] 添加/更改颜色

An.Color = acGreen

Public Sub Fragmented_Autocad()
Dim points() As Double
Dim acadApp  As AcadApplication
'=======================================
A$ = "########0.0"
On Error Resume Next ' GESTION DES ERREURS
Set acadApp = GetObject(, "AutoCAD.Application")
If Err Then
Err.Clear
On Error GoTo 0
End If
Set acadApp = CreateObject("AutoCAD.Application.17") ''<--18 for A2010
If Err Then
MsgBox Err.Description
Exit Sub
End If
acadApp.Visible = True ' AUTOCAD
Set AcadDoc = acadApp.ActiveDocument
Set AcadUtil = AcadDoc.Utility
AcadDoc.ActiveSpace = acModelSpace
' ======================================================================
N = 33  '
' ======================================================================
ReDim points(0 To 9) As Double
Lunitcell = 105.41
dx = Lunitcell / (N + 0.2) ' mm - corresponds to 1/8 inch sheet
dy = dx ' mm
dz = dx ' mm
m = Int(N / 2)
Overlap = dx / 10
Lx = dx + 2 * Overlap ' Pixel Size
Ly = dy + 2 * Overlap
lz = dz + 2 * Overlap
For I = 1 To N / 2 ' loop on x
For J = 1 To I  ' loop on y
uk = Rnd(I + J)
uk = 1
If uk > 0.5 Then
'Q1 - x=minus - y=minus - x=i - y=j - Q1 - Q1 - Q1 - Q1 - Q1 - Q1 - Q1 - Q1 - Q1 - Q1 - Q1 - Q1 - Q1 - Q1 - Q1 - Q1 - Q1 - Q1 - Q1 - Q1 - Q1 - Q1 - Q1 - Q1
x1 = -(m * dx + Lx / 2 - dx * (I - 1)): y1 = -(m * dy + Ly / 2 - dy * (J - 1)): x2 = x1 + Lx: y2 = y1 + Ly
points(0) = x1: points(1) = -y1: points(2) = x2: points(3) = -y1: points(4) = x2: points(5) = -y2: points(6) = x1: points(7) = -y2: points( = x1: points(9) = -y1
Debug.Print "Q1 ", points(0), points(1), points(2), points(3), points(4), points(5), points(6), points(7), points(
Set An = AcadDoc.ModelSpace.AddLightWeightPolyline(points) ' add points (nodes)
An.Color = acGreen
'Q2 - x=minus - y=minus - x=j - y=i - Q2 - Q2 - Q2 - Q2 - Q2 - Q2 - Q2 - Q2 - Q2 - Q2 - Q2 - Q2 - Q2 - Q2 - Q2 - Q2 - Q2 - Q2 - Q2 - Q2 - Q2 - Q2 - Q2 - Q2
If I <> J Then
x1 = -(m * dx + Lx / 2 - dx * (J - 1)): y1 = -(m * dy + Ly / 2 - dy * (I - 1)): x2 = x1 + Lx: y2 = y1 + Ly
points(0) = x1: points(1) = -y1: points(2) = x2: points(3) = -y1: points(4) = x2: points(5) = -y2: points(6) = x1: points(7) = -y2: points( = x1: points(9) = -y1
Set An = AcadDoc.ModelSpace.AddLightWeightPolyline(points) ' add points (nodes)
An.Color = acblue
End If
'Q3 -x = plus - y = minus - x = J - y = I - Q3 - Q3 - Q3 - Q3 - Q3 - Q3 - Q3 - Q3 - Q3 - Q3 - Q3 - Q3 - Q3 - Q3 - Q3 - Q3 - Q3 - Q3 - Q3 - Q3 - Q3 - Q3 - Q3 - Q3
x1 = (m * dx + Lx / 2 - dx * (I - 1)): y1 = -(m * dy + Ly / 2 - dy * (J - 1)): x2 = x1 - Lx: y2 = y1 + Ly
points(0) = x1: points(1) = -y1: points(2) = x2: points(3) = -y1: points(4) = x2: points(5) = -y2: points(6) = x1: points(7) = -y2: points( = x1: points(9) = -y1
Set An = AcadDoc.ModelSpace.AddLightWeightPolyline(points) ' add points (nodes)
An.Color = acYellow
'Q4 - x=plus - y=minus - x=i - y=j - Q4 - Q4 - Q4 - Q4 - Q4 - Q4 - Q4 - Q4 - Q4 - Q4 - Q4 - Q4 - Q4 - Q4 - Q4 - Q4 - Q4 - Q4 - Q4 - Q4 - Q4 - Q4 - Q4 - Q4
If I <> J Then
x1 = (m * dx + Lx / 2 - dx * (J - 1)): y1 = -(m * dy + Ly / 2 - dy * (I - 1)): x2 = x1 - Lx: y2 = y1 + Ly
points(0) = x1: points(1) = -y1: points(2) = x2: points(3) = -y1: points(4) = x2: points(5) = -y2: points(6) = x1: points(7) = -y2: points( = x1: points(9) = -y1
Set An = AcadDoc.ModelSpace.AddLightWeightPolyline(points) ' add points (nodes)
An.Color = acMagenta
End If
'Q5 - x=plus - y=plus - x=j - y=i - Q5 - Q5 - Q5 - Q5 - Q5 - Q5 - Q5 - Q5 - Q5 - Q5 - Q5 - Q5 - Q5 - Q5 - Q5 - Q5 - Q5 - Q5 - Q5 - Q5 - Q5 - Q5 - Q5 - Q5
x1 = (m * dx + Lx / 2 - dx * (I - 1)): y1 = (m * dy + Ly / 2 - dy * (J - 1)): x2 = x1 - Lx: y2 = y1 - Ly
points(0) = x1: points(1) = -y1: points(2) = x2: points(3) = -y1: points(4) = x2: points(5) = -y2: points(6) = x1: points(7) = -y2: points( = x1: points(9) = -y1
An.Color = aclightblue
Set An = AcadDoc.ModelSpace.AddLightWeightPolyline(points) ' add points (nodes)
'Q6 - x=plus - y=plus - x=j - y=i - Q6 - Q6 - Q6 - Q6 - Q6 - Q6 - Q6 - Q6 - Q6 - Q6 - Q6 - Q6 - Q6 - Q6 - Q6 - Q6 - Q6 - Q6 - Q6 - Q6 - Q6 - Q6 - Q6 - Q6
If I <> J Then
x1 = (m * dx + Lx / 2 - dx * (J - 1)): y1 = (m * dy + Ly / 2 - dy * (I - 1)):: x2 = x1 - Lx: y2 = y1 - Ly
points(0) = x1: points(1) = -y1: points(2) = x2: points(3) = -y1: points(4) = x2: points(5) = -y2: points(6) = x1: points(7) = -y2: points( = x1: points(9) = -y1
Set An = AcadDoc.ModelSpace.AddLightWeightPolyline(points) ' add points (nodes)
An.Color = acBlack
End If
'Q7 - x=minus - y=plus - x=j - y=i - Q7 - Q7 - Q7 - Q7 - Q7 - Q7 - Q7 - Q7 - Q7 - Q7 - Q7 - Q7 - Q7 - Q7 - Q7 - Q7 - Q7 - Q7 - Q7 - Q7 - Q7 - Q7 - Q7 - Q7
x1 = -(m * dx + Lx / 2 - dx * (I - 1)): y1 = (m * dy + Ly / 2 - dy * (J - 1)): x2 = x1 + Lx: y2 = y1 - Ly
points(0) = x1: points(1) = -y1: points(2) = x2: points(3) = -y1: points(4) = x2: points(5) = -y2: points(6) = x1: points(7) = -y2: points( = x1: points(9) = -y1
Debug.Print "Q7 ", points(0), points(1), points(2), points(3), points(4), points(5), points(6), points(7), points(
An.Color = acYellow
Set An = AcadDoc.ModelSpace.AddLightWeightPolyline(points) ' add points (nodes)
'Q8 -x = minus - y = plus - x = I - y = J - Q8 - Q8 - Q8 - Q8 - Q8 - Q8 - Q8 - Q8 - Q8 - Q8 - Q8 - Q8 - Q8 - Q8 - Q8 - Q8 - Q8 - Q8 - Q8 - Q8 - Q8 - Q8 - Q8 - Q8
If I <> J Then
x1 = -(m * dx + Lx / 2 - dx * (J - 1)): y1 = (m * dy + Ly / 2 - dy * (I - 1)): x2 = x1 + Lx: y2 = y1 - Ly
points(0) = x1: points(1) = -y1: points(2) = x2: points(3) = -y1: points(4) = x2: points(5) = -y2: points(6) = x1: points(7) = -y2: points( = x1: points(9) = -y1
Set An = AcadDoc.ModelSpace.AddLightWeightPolyline(points) ' add points (nodes)
An.Color = acYellow
End If
End If
Next J
Next I
For k = 1 To N
x1 = -(m * dx + Lx / 2 - dx * (k - 1)): y1 = -Ly / 2: x2 = x1 + Lx: y2 = y1 + Ly
points(0) = x1: points(1) = -y1: points(2) = x2: points(3) = -y1: points(4) = x2: points(5) = -y2: points(6) = x1: points(7) = -y2: points( = x1: points(9) = -y1
An.Color = acYellow
Set An = AcadDoc.ModelSpace.AddLightWeightPolyline(points) ' add points (nodes)
Next k
For k = 1 To N
If k <> Int(N / 2) + 1 Then
x1 = -Lx / 2: y1 = -(m * dx + Lx / 2 - dx * (k - 1)): x2 = x1 + Lx: y2 = y1 + Ly
points(0) = x1: points(1) = -y1: points(2) = x2: points(3) = -y1: points(4) = x2: points(5) = -y2: points(6) = x1: points(7) = -y2: points( = x1: points(9) = -y1
Set An = AcadDoc.ModelSpace.AddLightWeightPolyline(points) ' add points (nodes)
An.Color = acYellow
End If
Next k
Close 1
End Sub