1//////////////////////////////////////////////////////////////////////
2// LibFile: vnf.scad
3// The Vertices'N'Faces structure (VNF) holds the data used by polyhedron() to construct objects: a vertex
4// list and a list of faces. This library makes it easier to construct polyhedra by providing
5// functions to construct, merge, and modify VNF data, while avoiding common pitfalls such as
6// reversed faces. It can find faults in your polyhedrons. Note that this file is for low level manipulation
7// of lists of vertices and faces: it can perform some simple transformations on VNF structures
8// but cannot perform boolean operations on the polyhedrons represented by VNFs.
9// Includes:
10// include <BOSL2/std.scad>
11// FileGroup: Advanced Modeling
12// FileSummary: Vertices 'n' Faces structure. Makes polyhedron() easier to use.
13// FileFootnotes: STD=Included in std.scad
14//////////////////////////////////////////////////////////////////////
15
16
17// Section: Creating Polyhedrons with VNF Structures
18// VNF stands for "Vertices'N'Faces". VNF structures are 2-item lists, `[VERTICES,FACES]` where the
19// first item is a list of vertex points, and the second is a list of face indices into the vertex
20// list. Each VNF is self contained, with face indices referring only to its own vertex list.
21// You can construct a `polyhedron()` in parts by describing each part in a self-contained VNF, then
22// merge the various VNFs to get the completed polyhedron vertex list and faces.
23
24/// Constant: EMPTY_VNF
25/// Description:
26/// The empty VNF data structure. Equal to `[[],[]]`.
27EMPTY_VNF = [[],[]]; // The standard empty VNF with no vertices or faces.
28
29
30// Function: vnf_vertex_array()
31// Usage:
32// vnf = vnf_vertex_array(points, [caps=], [cap1=], [cap2=], [style=], [reverse=], [col_wrap=], [row_wrap=]);
33// Description:
34// Creates a VNF structure from a rectangular vertex list, by dividing the vertices into columns and rows,
35// adding faces to tile the surface. You can optionally have faces added to wrap the last column
36// back to the first column, or wrap the last row to the first. Endcaps can be added to either
37// the first and/or last rows. The style parameter determines how the quadrilaterals are divided into
38// triangles. The default style is an arbitrary, systematic subdivision in the same direction. The "alt" style
39// is the uniform subdivision in the other (alternate) direction. The "min_edge" style picks the shorter edge to
40// subdivide for each quadrilateral, so the division may not be uniform across the shape. The "quincunx" style
41// adds a vertex in the center of each quadrilateral and creates four triangles, and the "convex" and "concave" styles
42// chooses the locally convex/concave subdivision. Degenerate faces
43// are not included in the output, but if this results in unused vertices they will still appear in the output.
44// Arguments:
45// points = A list of vertices to divide into columns and rows.
46// ---
47// caps = If true, add endcap faces to the first AND last rows.
48// cap1 = If true, add an endcap face to the first row.
49// cap2 = If true, add an endcap face to the last row.
50// col_wrap = If true, add faces to connect the last column to the first.
51// row_wrap = If true, add faces to connect the last row to the first.
52// reverse = If true, reverse all face normals.
53// style = The style of subdividing the quads into faces. Valid options are "default", "alt", "min_edge", "quincunx", "convex" and "concave".
54// Example(3D):
55// vnf = vnf_vertex_array(
56// points=[
57// for (h = [0:5:180-EPSILON]) [
58// for (t = [0:5:360-EPSILON])
59// cylindrical_to_xyz(100 + 12 * cos((h/2 + t)*6), t, h)
60// ]
61// ],
62// col_wrap=true, caps=true, reverse=true, style="alt"
63// );
64// vnf_polyhedron(vnf);
65// Example(3D): Both `col_wrap` and `row_wrap` are true to make a torus.
66// vnf = vnf_vertex_array(
67// points=[
68// for (a=[0:5:360-EPSILON])
69// apply(
70// zrot(a) * right(30) * xrot(90),
71// path3d(circle(d=20))
72// )
73// ],
74// col_wrap=true, row_wrap=true, reverse=true
75// );
76// vnf_polyhedron(vnf);
77// Example(3D): Möbius Strip. Note that `row_wrap` is not used, and the first and last profile copies are the same.
78// vnf = vnf_vertex_array(
79// points=[
80// for (a=[0:5:360]) apply(
81// zrot(a) * right(30) * xrot(90) * zrot(a/2+60),
82// path3d(square([1,10], center=true))
83// )
84// ],
85// col_wrap=true, reverse=true
86// );
87// vnf_polyhedron(vnf);
88// Example(3D): Assembling a Polyhedron from Multiple Parts
89// wall_points = [
90// for (a = [-90:2:90]) apply(
91// up(a) * scale([1-0.1*cos(a*6),1-0.1*cos((a+90)*6),1]),
92// path3d(circle(d=100))
93// )
94// ];
95// cap = [
96// for (a = [0:0.01:1+EPSILON]) apply(
97// up(90-5*sin(a*360*2)) * scale([a,a,1]),
98// wall_points[0]
99// )
100// ];
101// cap1 = [for (p=cap) down(90, p=zscale(-1, p=p))];
102// cap2 = [for (p=cap) up(90, p=p)];
103// vnf1 = vnf_vertex_array(points=wall_points, col_wrap=true);
104// vnf2 = vnf_vertex_array(points=cap1, col_wrap=true);
105// vnf3 = vnf_vertex_array(points=cap2, col_wrap=true, reverse=true);
106// vnf_polyhedron([vnf1, vnf2, vnf3]);
107// Example(3D): Building a Multi-Stage Cylindrical Ramp
108// include <BOSL2/rounding.scad>
109// major_r = 50;
110// groove_profile = [
111// [-10,0], each arc(points=[[-7,0],[0,-3],[7,0]]), [10,0]
112// ];
113// ramp_profile = [ [-10,25], [90,25], [180,5], [190,5] ];
114// rgroove = apply(right(major_r) * xrot(90), path3d(groove_profile));
115// rprofile = round_corners(ramp_profile, radius=20, closed=false, $fn=72);
116// vnf = vnf_vertex_array([
117// for (a = [ramp_profile[0].x : 1 : last(ramp_profile).x]) let(
118// z = lookup(a,rprofile),
119// m = zrot(a) * up(z)
120// )
121// apply(m, [ [rgroove[0].x,0,-z], each rgroove, [last(rgroove).x,0,-z] ])
122// ], caps=true, col_wrap=true, reverse=true);
123// vnf_polyhedron(vnf, convexity=8);
124function vnf_vertex_array(
125 points,
126 caps, cap1, cap2,
127 col_wrap=false,
128 row_wrap=false,
129 reverse=false,
130 style="default"
131) =
132 assert(!(any([caps,cap1,cap2]) && !col_wrap), "col_wrap must be true if caps are requested")
133 assert(!(any([caps,cap1,cap2]) && row_wrap), "Cannot combine caps with row_wrap")
134 assert(in_list(style,["default","alt","quincunx", "convex","concave", "min_edge"]))
135 assert(is_matrix(points[0], n=3),"Point array has the wrong shape or points are not 3d")
136 assert(is_consistent(points), "Non-rectangular or invalid point array")
137 let(
138 pts = flatten(points),
139 pcnt = len(pts),
140 rows = len(points),
141 cols = len(points[0])
142 )
143 rows<=1 || cols<=1 ? EMPTY_VNF :
144 let(
145 cap1 = first_defined([cap1,caps,false]),
146 cap2 = first_defined([cap2,caps,false]),
147 colcnt = cols - (col_wrap?0:1),
148 rowcnt = rows - (row_wrap?0:1),
149 verts = [
150 each pts,
151 if (style=="quincunx")
152 for (r = [0:1:rowcnt-1], c = [0:1:colcnt-1])
153 let(
154 i1 = ((r+0)%rows)*cols + ((c+0)%cols),
155 i2 = ((r+1)%rows)*cols + ((c+0)%cols),
156 i3 = ((r+1)%rows)*cols + ((c+1)%cols),
157 i4 = ((r+0)%rows)*cols + ((c+1)%cols)
158 )
159 mean([pts[i1], pts[i2], pts[i3], pts[i4]])
160 ],
161 allfaces = [
162 if (cap1) count(cols,reverse=!reverse),
163 if (cap2) count(cols,(rows-1)*cols, reverse=reverse),
164 for (r = [0:1:rowcnt-1], c=[0:1:colcnt-1])
165 each
166 let(
167 i1 = ((r+0)%rows)*cols + ((c+0)%cols),
168 i2 = ((r+1)%rows)*cols + ((c+0)%cols),
169 i3 = ((r+1)%rows)*cols + ((c+1)%cols),
170 i4 = ((r+0)%rows)*cols + ((c+1)%cols),
171 faces =
172 style=="quincunx"?
173 let(i5 = pcnt + r*colcnt + c)
174 [[i1,i5,i2],[i2,i5,i3],[i3,i5,i4],[i4,i5,i1]]
175 : style=="alt"?
176 [[i1,i4,i2],[i2,i4,i3]]
177 : style=="min_edge"?
178 let(
179 d42=norm(pts[i4]-pts[i2]),
180 d13=norm(pts[i1]-pts[i3]),
181 shortedge = d42<d13+EPSILON
182 ? [[i1,i4,i2],[i2,i4,i3]]
183 : [[i1,i3,i2],[i1,i4,i3]]
184 )
185 shortedge
186 : style=="convex"?
187 let( // Find normal for 3 of the points. Is the other point above or below?
188 n = (reverse?-1:1)*cross(pts[i2]-pts[i1],pts[i3]-pts[i1]),
189 convexfaces = n==0
190 ? [[i1,i4,i3]]
191 : n*pts[i4] > n*pts[i1]
192 ? [[i1,i4,i2],[i2,i4,i3]]
193 : [[i1,i3,i2],[i1,i4,i3]]
194 )
195 convexfaces
196 : style=="concave"?
197 let( // Find normal for 3 of the points. Is the other point above or below?
198 n = (reverse?-1:1)*cross(pts[i2]-pts[i1],pts[i3]-pts[i1]),
199 concavefaces = n==0
200 ? [[i1,i4,i3]]
201 : n*pts[i4] <= n*pts[i1]
202 ? [[i1,i4,i2],[i2,i4,i3]]
203 : [[i1,i3,i2],[i1,i4,i3]]
204 )
205 concavefaces
206 : [[i1,i3,i2],[i1,i4,i3]],
207 // remove degenerate faces
208 culled_faces= [for(face=faces)
209 if (norm(verts[face[0]]-verts[face[1]])>EPSILON &&
210 norm(verts[face[1]]-verts[face[2]])>EPSILON &&
211 norm(verts[face[2]]-verts[face[0]])>EPSILON)
212 face
213 ],
214 rfaces = reverse? [for (face=culled_faces) reverse(face)] : culled_faces
215 )
216 rfaces,
217 ]
218 )
219 [verts,allfaces];
220
221
222// Function: vnf_tri_array()
223// Usage:
224// vnf = vnf_tri_array(points, [row_wrap], [reverse])
225// Description:
226// Produces a vnf from an array of points where each row length can differ from the adjacent rows by up to 2 in length. This enables
227// the construction of triangular VNF patches. The resulting VNF can be wrapped along the rows by setting `row_wrap` to true.
228// You cannot wrap columns: if you need to do that you'll need to merge two VNF arrays that share edges. Degenerate faces
229// are not included in the output, but if this results in unused vertices they will still appear in the output.
230// Arguments:
231// points = List of point lists for each row
232// row_wrap = If true then add faces connecting the first row and last row. These rows must differ by at most 2 in length.
233// reverse = Set this to reverse the direction of the faces
234// Example(3D,NoAxes): Each row has one more point than the preceeding one.
235// pts = [for(y=[1:1:10]) [for(x=[0:y-1]) [x,y,y]]];
236// vnf = vnf_tri_array(pts);
237// vnf_wireframe(vnf,width=0.1);
238// color("red")move_copies(flatten(pts)) sphere(r=.15,$fn=9);
239// Example(3D,NoAxes): Each row has two more points than the preceeding one.
240// pts = [for(y=[0:2:10]) [for(x=[-y/2:y/2]) [x,y,y]]];
241// vnf = vnf_tri_array(pts);
242// vnf_wireframe(vnf,width=0.1);
243// color("red")move_copies(flatten(pts)) sphere(r=.15,$fn=9);
244// Example(3D): Merging two VNFs to construct a cone with one point length change between rows.
245// pts1 = [for(z=[0:10]) path3d(arc(3+z,r=z/2+1, angle=[0,180]),10-z)];
246// pts2 = [for(z=[0:10]) path3d(arc(3+z,r=z/2+1, angle=[180,360]),10-z)];
247// vnf = vnf_join([vnf_tri_array(pts1),
248// vnf_tri_array(pts2)]);
249// color("green")vnf_wireframe(vnf,width=0.1);
250// vnf_polyhedron(vnf);
251// Example(3D): Cone with length change two between rows
252// pts1 = [for(z=[0:1:10]) path3d(arc(3+2*z,r=z/2+1, angle=[0,180]),10-z)];
253// pts2 = [for(z=[0:1:10]) path3d(arc(3+2*z,r=z/2+1, angle=[180,360]),10-z)];
254// vnf = vnf_join([vnf_tri_array(pts1),
255// vnf_tri_array(pts2)]);
256// color("green")vnf_wireframe(vnf,width=0.1);
257// vnf_polyhedron(vnf);
258// Example(3D,NoAxes): Point count can change irregularly
259// lens = [10,9,7,5,6,8,8,10];
260// pts = [for(y=idx(lens)) lerpn([-lens[y],y,y],[lens[y],y,y],lens[y])];
261// vnf = vnf_tri_array(pts);
262// vnf_wireframe(vnf,width=0.1);
263// color("red")move_copies(flatten(pts)) sphere(r=.15,$fn=9);
264function vnf_tri_array(points, row_wrap=false, reverse=false) =
265 let(
266 lens = [for(row=points) len(row)],
267 rowstarts = [0,each cumsum(lens)],
268 faces =
269 [for(i=[0:1:len(points) - 1 - (row_wrap ? 0 : 1)]) each
270 let(
271 rowstart = rowstarts[i],
272 nextrow = select(rowstarts,i+1),
273 delta = select(lens,i+1)-lens[i]
274 )
275 delta == 0 ?
276 [for(j=[0:1:lens[i]-2]) reverse ? [j+rowstart+1, j+rowstart, j+nextrow] : [j+rowstart, j+rowstart+1, j+nextrow],
277 for(j=[0:1:lens[i]-2]) reverse ? [j+rowstart+1, j+nextrow, j+nextrow+1] : [j+rowstart+1, j+nextrow+1, j+nextrow]] :
278 delta == 1 ?
279 [for(j=[0:1:lens[i]-2]) reverse ? [j+rowstart+1, j+rowstart, j+nextrow+1] : [j+rowstart, j+rowstart+1, j+nextrow+1],
280 for(j=[0:1:lens[i]-1]) reverse ? [j+rowstart, j+nextrow, j+nextrow+1] : [j+rowstart, j+nextrow+1, j+nextrow]] :
281 delta == -1 ?
282 [for(j=[0:1:lens[i]-3]) reverse ? [j+rowstart+1, j+nextrow, j+nextrow+1]: [j+rowstart+1, j+nextrow+1, j+nextrow],
283 for(j=[0:1:lens[i]-2]) reverse ? [j+rowstart+1, j+rowstart, j+nextrow] : [j+rowstart, j+rowstart+1, j+nextrow]] :
284 let(count = floor((lens[i]-1)/2))
285 delta == 2 ?
286 [
287 for(j=[0:1:count-1]) reverse ? [j+rowstart+1, j+rowstart, j+nextrow+1] : [j+rowstart, j+rowstart+1, j+nextrow+1], // top triangles left
288 for(j=[count:1:lens[i]-2]) reverse ? [j+rowstart+1, j+rowstart, j+nextrow+2] : [j+rowstart, j+rowstart+1, j+nextrow+2], // top triangles right
289 for(j=[0:1:count]) reverse ? [j+rowstart, j+nextrow, j+nextrow+1] : [j+rowstart, j+nextrow+1, j+nextrow], // bot triangles left
290 for(j=[count+1:1:select(lens,i+1)-2]) reverse ? [j+rowstart-1, j+nextrow, j+nextrow+1] : [j+rowstart-1, j+nextrow+1, j+nextrow], // bot triangles right
291 ] :
292 delta == -2 ?
293 [
294 for(j=[0:1:count-2]) reverse ? [j+nextrow, j+nextrow+1, j+rowstart+1] : [j+nextrow, j+rowstart+1, j+nextrow+1],
295 for(j=[count-1:1:lens[i]-4]) reverse ? [j+nextrow,j+nextrow+1,j+rowstart+2] : [j+nextrow,j+rowstart+2, j+nextrow+1],
296 for(j=[0:1:count-1]) reverse ? [j+nextrow, j+rowstart+1, j+rowstart] : [j+nextrow, j+rowstart, j+rowstart+1],
297 for(j=[count:1:select(lens,i+1)]) reverse ? [ j+nextrow-1, j+rowstart+1, j+rowstart]: [ j+nextrow-1, j+rowstart, j+rowstart+1],
298 ] :
299 assert(false,str("Unsupported row length difference of ",delta, " between row ",i," and ",(i+1)%len(points)))
300 ],
301 verts = flatten(points),
302 culled_faces=
303 [for(face=faces)
304 if (norm(verts[face[0]]-verts[face[1]])>EPSILON &&
305 norm(verts[face[1]]-verts[face[2]])>EPSILON &&
306 norm(verts[face[2]]-verts[face[0]])>EPSILON)
307 face
308 ]
309 )
310 [flatten(points), culled_faces];
311
312
313
314// Function: vnf_join()
315// Usage:
316// vnf = vnf_join([VNF, VNF, VNF, ...]);
317// Description:
318// Given a list of VNF structures, merges them all into a single VNF structure.
319// Combines all the points of the input VNFs and labels the faces appropriately.
320// All the points in the input VNFs will appear in the output, even if they are
321// duplicates of each other. It is valid to repeat points in a VNF, but if you
322// with to remove the duplicates that will occur along joined edges, use {{vnf_merge_points()}}.
323// .
324// Note that this is a tool for manipulating polyhedron data. It is for
325// building up a full polyhedron from partial polyhedra.
326// It is *not* a union operator for VNFs. The VNFs to be joined must not intersect each other,
327// except at edges, or the result will be an invalid polyhedron. Similarly the
328// result must not have any other illegal polyhedron characteristics, such as creating
329// more than two faces sharing the same edge.
330// If you want a valid result it is your responsibility to ensure that the polyhedron
331// has no holes, no intersecting faces or edges, and obeys all the requirements
332// that CGAL expects.
333// .
334// For example, if you combine two pyramids to try to make an octahedron, the result will
335// be invalid because of the two internal faces created by the pyramid bases. A valid
336// use would be to build a cube missing one face and a pyramid missing its base and
337// then join them into a cube with a point.
338// Arguments:
339// vnfs = a list of the VNFs to joint into one VNF.
340// Example(3D,VPR=[60,0,26],VPD=55,VPT=[5.6,-5.3,9.8]): Here is a VNF where the top face is missing. It is not a valid polyhedron like this, but we can use it as a building block to make a polyhedron.
341// bottom = vnf_vertex_array([path3d(rect(8)), path3d(rect(5),4)],col_wrap=true,cap1=true);
342// vnf_polyhedron(bottom);
343// Example(3D,VPR=[60,0,26],VPD=55,VPT=[5.6,-5.3,9.8]): Here is a VNF that also has a missing face.
344// triangle = yrot(-90,path3d(regular_ngon(n=3,side=5,anchor=LEFT)));
345// top = up(4,vnf_vertex_array([list_set(right(2.5,triangle),0,[0,0,7]),
346// right(6,triangle)
347// ], col_wrap=true, cap2=true));
348// vnf_polyhedron(zrot(90,top));
349// Example(3D,VPR=[60,0,26],VPD=55,VPT=[5.6,-5.3,9.8]): Using vnf_join combines the two VNFs into a single VNF. Note that they share an edge. But the result still isn't closed, so it is not yet a valid polyhedron.
350// bottom = vnf_vertex_array([path3d(rect(8)), path3d(rect(5),4)],col_wrap=true,cap1=true);
351// triangle = yrot(-90,path3d(regular_ngon(n=3,side=5,anchor=LEFT)));
352// top = up(4,vnf_vertex_array([list_set(right(2.5,triangle),0,[0,0,7]),
353// right(6,triangle)
354// ], col_wrap=true, cap2=true));
355// full = vnf_join([bottom,zrot(90,top)]);
356// vnf_polyhedron(full);
357// Example(3D,VPR=[60,0,26],VPD=55,VPT=[5.6,-5.3,9.8]): If we add enough pieces, and the pieces are all consistent with each other, then we can arrive at a valid polyhedron like this one. To be valid you need to meet all the CGAL requirements: every edge has exactly two faces, all faces are in clockwise order, no intersections of edges.
358// bottom = vnf_vertex_array([path3d(rect(8)), path3d(rect(5),4)],col_wrap=true,cap1=true);
359// triangle = yrot(-90,path3d(regular_ngon(n=3,side=5,anchor=LEFT)));
360// top = up(4,vnf_vertex_array([list_set(right(2.5,triangle),0,[0,0,7]),
361// right(6,triangle)
362// ], col_wrap=true, cap2=true));
363// full = vnf_join([bottom,
364// for(theta=[0:90:359]) zrot(theta,top)
365// ]);
366// vnf_polyhedron(full);
367// Example(3D): The vnf_join function is not a union operator for polyhedra. If any faces intersect, like they do in this example where we combine the faces of two cubes, the result is invalid and will give rise to CGAL errors when you add more objects into the model.
368// cube1 = cube(5);
369// cube2 = move([2,2,2],cube1);
370// badvnf = vnf_join([cube1,cube2]);
371// vnf_polyhedron(badvnf);
372// right(2.5)up(3)color("red")
373// text3d("Invalid",size=1,anchor=CENTER,
374// orient=FRONT,h=.1);
375function vnf_join(vnfs) =
376 assert(is_vnf_list(vnfs) , "Input must be a list of VNFs")
377 len(vnfs)==1 ? vnfs[0]
378 :
379 let (
380 offs = cumsum([ 0, for (vnf = vnfs) len(vnf[0]) ]),
381 verts = [for (vnf=vnfs) each vnf[0]],
382 faces =
383 [ for (i = idx(vnfs))
384 let( faces = vnfs[i][1] )
385 for (face = faces)
386 if ( len(face) >= 3 )
387 [ for (j = face)
388 assert( j>=0 && j<len(vnfs[i][0]),
389 str("VNF number ", i, " has a face indexing an nonexistent vertex") )
390 offs[i] + j ]
391 ]
392 )
393 [verts,faces];
394
395
396
397// Function: vnf_from_polygons()
398// Usage:
399// vnf = vnf_from_polygons(polygons);
400// Description:
401// Given a list of 3d polygons, produces a VNF containing those polygons.
402// It is up to the caller to make sure that the points are in the correct order to make the face
403// normals point outwards. No checking for duplicate vertices is done. If you want to
404// remove duplicate vertices use {{vnf_merge_points()}}.
405// Arguments:
406// polygons = The list of 3d polygons to turn into a VNF
407function vnf_from_polygons(polygons) =
408 assert(is_list(polygons) && is_path(polygons[0]),"Input should be a list of polygons")
409 let(
410 offs = cumsum([0, for(p=polygons) len(p)]),
411 faces = [for(i=idx(polygons))
412 [for (j=idx(polygons[i])) offs[i]+j]
413 ]
414 )
415 [flatten(polygons), faces];
416
417
418
419
420function _path_path_closest_vertices(path1,path2) =
421 let(
422 dists = [for (i=idx(path1)) let(j=closest_point(path1[i],path2)) [j,norm(path2[j]-path1[i])]],
423 i1 = min_index(column(dists,1)),
424 i2 = dists[i1][0]
425 ) [dists[i1][1], i1, i2];
426
427
428function _join_paths_at_vertices(path1,path2,v1,v2) =
429 let(
430 repeat_start = !approx(path1[v1],path2[v2]),
431 path1 = clockwise_polygon(list_rotate(path1,v1)),
432 path2 = ccw_polygon(list_rotate(path2,v2))
433 )
434 [
435 each path1,
436 if (repeat_start) path1[0],
437 each path2,
438 if (repeat_start) path2[0],
439 ];
440
441
442/// Internal Function: _cleave_connected_region(region, eps)
443/// Description:
444/// Given a region that is connected and has its outer border in region[0],
445/// produces a overlapping connected path to join internal holes to
446/// the outer border without adding points. Output is a single non-simple polygon.
447/// Requirements:
448/// It expects that all region paths be simple closed paths, with region[0] CW and
449/// the other paths CCW and encircled by region[0]. The input region paths are also
450/// supposed to be disjoint except for common vertices and common edges but with
451/// no crossings. It may return `undef` if these conditions are not met.
452/// This function implements an extension of the algorithm discussed in:
453/// https://www.geometrictools.com/Documentation/TriangulationByEarClipping.pdf
454function _cleave_connected_region(region, eps=EPSILON) =
455 len(region)==1 ? region[0] :
456 let(
457 outer = deduplicate(region[0]), //
458 holes = [for(i=[1:1:len(region)-1]) // deduplication possibly unneeded
459 deduplicate( region[i] ) ], //
460 extridx = [for(li=holes) max_index(column(li,0)) ],
461 // the right extreme vertex for each hole sorted by decreasing x values
462 extremes = sort( [for(i=idx(holes)) [ i, extridx[i], -holes[i][extridx[i]].x] ], idx=2 )
463 )
464 _polyHoles(outer, holes, extremes, eps, 0);
465
466
467// connect the hole paths one at a time to the outer path.
468// 'extremes' is the list of the right extreme vertex of each hole sorted by decreasing abscissas
469// see: _cleave_connected_region(region, eps)
470function _polyHoles(outer, holes, extremes, eps=EPSILON, n=0) =
471 let(
472 extr = extremes[n], //
473 hole = holes[extr[0]], // hole path to bridge to the outer path
474 ipt = extr[1], // index of the hole point with maximum abscissa
475 brdg = _bridge(hole[ipt], outer, eps) // the index of a point in outer to bridge hole[ipt] to
476 )
477 brdg == undef ? undef :
478 let(
479 l = len(outer),
480 lh = len(hole),
481 // the new outer polygon bridging the hole to the old outer
482 npoly =
483 approx(outer[brdg], hole[ipt], eps)
484 ? [ for(i=[brdg: 1: brdg+l]) outer[i%l] ,
485 for(i=[ipt+1: 1: ipt+lh-1]) hole[i%lh] ]
486 : [ for(i=[brdg: 1: brdg+l]) outer[i%l] ,
487 for(i=[ipt: 1: ipt+lh]) hole[i%lh] ]
488 )
489 n==len(holes)-1 ? npoly :
490 _polyHoles(npoly, holes, extremes, eps, n+1);
491
492// find a point in outer to be connected to pt in the interior of outer
493// by a segment that not cross or touch any non adjacente edge of outer.
494// return the index of a vertex in the outer path where the bridge should end
495// see _polyHoles(outer, holes, extremes, eps)
496function _bridge(pt, outer,eps) =
497 // find the intersection of a ray from pt to the right
498 // with the boundary of the outer cycle
499 let(
500 l = len(outer),
501 crxs =
502 let( edges = pair(outer,wrap=true) )
503 [for( i = idx(edges) )
504 let( edge = edges[i] )
505 // consider just descending outer edges at right of pt crossing ordinate pt.y
506 if( (edge[0].y > pt.y) //+eps)
507 && (edge[1].y <= pt.y)
508 && _is_at_left(pt, [edge[1], edge[0]], eps) )
509 [ i,
510 // the point of edge with ordinate pt.y
511 abs(pt.y-edge[1].y)<eps ? edge[1] :
512 let( u = (pt-edge[1]).y / (edge[0]-edge[1]).y )
513 (1-u)*edge[1] + u*edge[0]
514 ]
515 ]
516 )
517 crxs == [] ? undef :
518 let(
519 // the intersection point of the nearest edge to pt with minimum slope
520 minX = min([for(p=crxs) p[1].x]),
521 crxcand = [for(crx=crxs) if(crx[1].x < minX+eps) crx ], // nearest edges
522 nearest = min_index([for(crx=crxcand)
523 (outer[crx[0]].x - pt.x) / (outer[crx[0]].y - pt.y) ]), // minimum slope
524 proj = crxcand[nearest],
525 vert0 = outer[proj[0]], // the two vertices of the nearest crossing edge
526 vert1 = outer[(proj[0]+1)%l],
527 isect = proj[1] // the intersection point
528 )
529 norm(pt-vert1) < eps ? (proj[0]+1)%l : // if pt touches an outer vertex, return its index
530 // as vert0.y > pt.y then pt!=vert0
531 norm(pt-isect) < eps ? undef : // if pt touches the middle of an outer edge -> error
532 let(
533 // the edge [vert0, vert1] necessarily satisfies vert0.y > vert1.y
534 // indices of candidates to an outer bridge point
535 cand =
536 (vert0.x > pt.x)
537 ? [ proj[0],
538 // select reflex vertices inside of the triangle [pt, vert0, isect]
539 for(i=idx(outer))
540 if( _tri_class(select(outer,i-1,i+1),eps) <= 0
541 && _pt_in_tri(outer[i], [pt, vert0, isect], eps)>=0 )
542 i
543 ]
544 : [ (proj[0]+1)%l,
545 // select reflex vertices inside of the triangle [pt, isect, vert1]
546 for(i=idx(outer))
547 if( _tri_class(select(outer,i-1,i+1),eps) <= 0
548 && _pt_in_tri(outer[i], [pt, isect, vert1], eps)>=0 )
549 i
550 ],
551 // choose the candidate outer[i] such that the line [pt, outer[i]] has minimum slope
552 // among those with minimum slope choose the nearest to pt
553 slopes = [for(i=cand) 1-abs(outer[i].x-pt.x)/norm(outer[i]-pt) ],
554 min_slp = min(slopes),
555 cand2 = [for(i=idx(cand)) if(slopes[i]<=min_slp+eps) cand[i] ],
556 nearest = min_index([for(i=cand2) norm(pt-outer[i]) ])
557 )
558 cand2[nearest];
559
560
561// Function: vnf_from_region()
562// Usage:
563// vnf = vnf_from_region(region, [transform], [reverse]);
564// Description:
565// Given a (two-dimensional) region, applies the given transformation matrix to it and makes a (three-dimensional) triangulated VNF of
566// faces for that region, reversed if desired.
567// Arguments:
568// region = The region to conver to a vnf.
569// transform = If given, a transformation matrix to apply to the faces generated from the region. Default: No transformation applied.
570// reverse = If true, reverse the normals of the faces generated from the region. An untransformed region will have face normals pointing `UP`. Default: false
571// Example(3D):
572// region = [square([20,10],center=true),
573// right(5,square(4,center=true)),
574// left(5,square(6,center=true))];
575// vnf = vnf_from_region(region);
576// color("gray")down(.125)
577// linear_extrude(height=.125)region(region);
578// vnf_wireframe(vnf,width=.25);
579function vnf_from_region(region, transform, reverse=false) =
580 let (
581 region = [for (path = region) deduplicate(path, closed=true)],
582 regions = region_parts(force_region(region)),
583 vnfs =
584 [
585 for (rgn = regions)
586 let(
587 cleaved = path3d(_cleave_connected_region(rgn))
588 )
589 assert( cleaved, "The region is invalid")
590 let(
591 face = is_undef(transform)? cleaved : apply(transform,cleaved),
592 faceidxs = reverse? [for (i=[len(face)-1:-1:0]) i] : [for (i=[0:1:len(face)-1]) i]
593 ) [face, [faceidxs]]
594 ],
595 outvnf = vnf_join(vnfs)
596 )
597 vnf_triangulate(outvnf);
598
599
600
601// Section: VNF Testing and Access
602
603
604// Function: is_vnf()
605// Usage:
606// bool = is_vnf(x);
607// Description:
608// Returns true if the given value looks like a VNF structure.
609function is_vnf(x) =
610 is_list(x) &&
611 len(x)==2 &&
612 is_list(x[0]) &&
613 is_list(x[1]) &&
614 (x[0]==[] || (len(x[0])>=3 && is_vector(x[0][0],3))) &&
615 (x[1]==[] || is_vector(x[1][0]));
616
617
618// Function: is_vnf_list()
619// Description: Returns true if the given value looks passingly like a list of VNF structures.
620function is_vnf_list(x) = is_list(x) && all([for (v=x) is_vnf(v)]);
621
622
623// Function: vnf_vertices()
624// Description: Given a VNF structure, returns the list of vertex points.
625function vnf_vertices(vnf) = vnf[0];
626
627
628// Function: vnf_faces()
629// Description: Given a VNF structure, returns the list of faces, where each face is a list of indices into the VNF vertex list.
630function vnf_faces(vnf) = vnf[1];
631
632
633
634// Section: Altering the VNF Internals
635
636
637// Function: vnf_reverse_faces()
638// Usage:
639// rvnf = vnf_reverse_faces(vnf);
640// Description:
641// Reverses the orientation of all the faces in the given VNF.
642function vnf_reverse_faces(vnf) =
643 [vnf[0], [for (face=vnf[1]) reverse(face)]];
644
645
646// Function: vnf_quantize()
647// Usage:
648// vnf2 = vnf_quantize(vnf,[q]);
649// Description:
650// Quantizes the vertex coordinates of the VNF to the given quanta `q`.
651// Arguments:
652// vnf = The VNF to quantize.
653// q = The quanta to quantize the VNF coordinates to.
654function vnf_quantize(vnf,q=pow(2,-12)) =
655 [[for (pt = vnf[0]) quant(pt,q)], vnf[1]];
656
657
658
659// Function: vnf_merge_points()
660// Usage:
661// new_vnf = vnf_merge_points(vnf, [eps]);
662// Description:
663// Given a VNF, consolidates all duplicate vertices with a tolerance `eps`, relabeling the faces as necessary,
664// and eliminating any face with fewer than 3 vertices. Unreferenced vertices of the input VNF are not dropped.
665// To remove such vertices uses {{vnf_drop_unused_points()}}.
666// Arguments:
667// vnf = a VNF to consolidate
668// eps = the tolerance in finding duplicates. Default: EPSILON
669function vnf_merge_points(vnf,eps=EPSILON) =
670 let(
671 verts = vnf[0],
672 dedup = vector_search(verts,eps,verts), // collect vertex duplicates
673 map = [for(i=idx(verts)) min(dedup[i]) ], // remap duplic vertices
674 offset = cumsum([for(i=idx(verts)) map[i]==i ? 0 : 1 ]), // remaping face vertex offsets
675 map2 = list(idx(verts))-offset, // map old vertex indices to new indices
676 nverts = [for(i=idx(verts)) if(map[i]==i) verts[i] ], // this doesn't eliminate unreferenced vertices
677 nfaces =
678 [ for(face=vnf[1])
679 let(
680 nface = [ for(vi=face) map2[map[vi]] ],
681 dface = [for (i=idx(nface))
682 if( nface[i]!=nface[(i+1)%len(nface)])
683 nface[i] ]
684 )
685 if(len(dface) >= 3) dface
686 ]
687 )
688 [nverts, nfaces];
689
690
691// Function: vnf_drop_unused_points()
692// Usage:
693// clean_vnf = vnf_drop_unused_points(vnf);
694// Description:
695// Remove all unreferenced vertices from a VNF. Note that in most
696// cases unreferenced vertices cause no harm, and this function may
697// be slow on large VNFs.
698function vnf_drop_unused_points(vnf) =
699 let(
700 flat = flatten(vnf[1]),
701 ind = _link_indicator(flat,0,len(vnf[0])-1),
702 verts = [for(i=idx(vnf[0])) if(ind[i]==1) vnf[0][i] ],
703 map = cumsum(ind)
704 )
705 [ verts, [for(face=vnf[1]) [for(v=face) map[v]-1 ] ] ];
706
707function _link_indicator(l,imin,imax) =
708 len(l) == 0 ? repeat(imax-imin+1,0) :
709 imax-imin<100 || len(l)<400 ? [for(si=search(list([imin:1:imax]),l,1)) si!=[] ? 1: 0 ] :
710 let(
711 pivot = floor((imax+imin)/2),
712 lesser = [ for(li=l) if( li< pivot) li ],
713 greater = [ for(li=l) if( li> pivot) li ]
714 )
715 concat( _link_indicator(lesser ,imin,pivot-1),
716 search(pivot,l,1) ? 1 : 0 ,
717 _link_indicator(greater,pivot+1,imax) ) ;
718
719// Function: vnf_triangulate()
720// Usage:
721// vnf2 = vnf_triangulate(vnf);
722// Description:
723// Triangulates faces in the VNF that have more than 3 vertices.
724// Arguments:
725// vnf = vnf to triangulate
726// Example(3D):
727// include <BOSL2/polyhedra.scad>
728// vnf = zrot(33,regular_polyhedron_info("vnf", "dodecahedron", side=12));
729// vnf_polyhedron(vnf);
730// triangulated = vnf_triangulate(vnf);
731// color("red")vnf_wireframe(triangulated,width=.3);
732function vnf_triangulate(vnf) =
733 let(
734 verts = vnf[0],
735 faces = [for (face=vnf[1])
736 each (len(face)==3 ? [face] :
737 let( tris = polygon_triangulate(verts, face) )
738 assert( tris!=undef, "Some `vnf` face cannot be triangulated.")
739 tris ) ]
740 )
741 [verts, faces];
742
743
744
745function _vnf_sort_vertices(vnf, idx=[2,1,0]) =
746 let(
747 verts = vnf[0],
748 faces = vnf[1],
749 vidx = sortidx(verts, idx=idx),
750 rvidx = sortidx(vidx),
751 sorted_vnf = [
752 [ for (i = vidx) verts[i] ],
753 [ for (face = faces) [ for (i = face) rvidx[i] ] ],
754 ]
755 ) sorted_vnf;
756
757
758
759// Function: vnf_slice()
760// Usage:
761// sliced = vnf_slice(vnf, dir, cuts);
762// Description:
763// Slice the faces of a VNF along a specified axis direction at a given list of cut points.
764// The cut points can appear in any order. You can use this to refine the faces of a VNF before
765// applying a nonlinear transformation to its vertex set.
766// Arguments:
767// vnf = vnf to slice
768// dir = normal direction to the slices, either "X", "Y" or "Z"
769// cuts = X, Y or Z values where cuts occur
770// Example(3D):
771// include <BOSL2/polyhedra.scad>
772// vnf = regular_polyhedron_info("vnf", "dodecahedron", side=12);
773// vnf_polyhedron(vnf);
774// sliced = vnf_slice(vnf, "X", [-6,-1,10]);
775// color("red")vnf_wireframe(sliced,width=.3);
776function vnf_slice(vnf,dir,cuts) =
777 let(
778 cuts = [for (cut=cuts) _shift_cut_plane(vnf,dir,cut)],
779 vert = vnf[0],
780 faces = [for(face=vnf[1]) select(vert,face)],
781 poly_list = _slice_3dpolygons(faces, dir, cuts)
782 )
783 vnf_merge_points(vnf_from_polygons(poly_list));
784
785
786function _shift_cut_plane(vnf,dir,cut,off=0.001) =
787 let(
788 I = ident(3),
789 dir_ind = ord(dir)-ord("X"),
790 verts = vnf[0],
791 on_cut = [for (x = verts * I[dir_ind]) if(approx(x,cut,eps=1e-4)) 1] != []
792 ) !on_cut? cut :
793 _shift_cut_plane(vnf,dir,cut+off);
794
795
796function _split_polygon_at_x(poly, x) =
797 let(
798 xs = column(poly,0)
799 ) (min(xs) >= x || max(xs) <= x)? [poly] :
800 let(
801 poly2 = [
802 for (p = pair(poly,true)) each [
803 p[0],
804 if(
805 (p[0].x < x && p[1].x > x) ||
806 (p[1].x < x && p[0].x > x)
807 ) let(
808 u = (x - p[0].x) / (p[1].x - p[0].x)
809 ) [
810 x, // Important for later exact match tests
811 u*(p[1].y-p[0].y)+p[0].y
812 ]
813 ]
814 ],
815 out1 = [for (p = poly2) if(p.x <= x) p],
816 out2 = [for (p = poly2) if(p.x >= x) p],
817 out3 = [
818 if (len(out1)>=3) each split_path_at_self_crossings(out1),
819 if (len(out2)>=3) each split_path_at_self_crossings(out2),
820 ],
821 out = [for (p=out3) if (len(p) > 2) cleanup_path(p)]
822 ) out;
823
824
825function _split_2dpolygons_at_each_x(polys, xs, _i=0) =
826 _i>=len(xs)? polys :
827 _split_2dpolygons_at_each_x(
828 [
829 for (poly = polys)
830 each _split_polygon_at_x(poly, xs[_i])
831 ], xs, _i=_i+1
832 );
833
834/// Internal Function: _slice_3dpolygons()
835/// Usage:
836/// splitpolys = _slice_3dpolygons(polys, dir, cuts);
837/// Topics: Geometry, Polygons, Intersections
838/// Description:
839/// Given a list of 3D polygons, a choice of X, Y, or Z, and a cut list, `cuts`, splits all of the polygons where they cross
840/// X/Y/Z at any value given in cuts.
841/// Arguments:
842/// polys = A list of 3D polygons to split.
843/// dir_ind = slice direction, 0=X, 1=Y, or 2=Z
844/// cuts = A list of scalar values for locating the cuts
845function _slice_3dpolygons(polys, dir, cuts) =
846 assert( [for (poly=polys) if (!is_path(poly,3)) 1] == [], "Expects list of 3D paths.")
847 assert( is_vector(cuts), "The split list must be a vector.")
848 assert( in_list(dir, ["X", "Y", "Z"]))
849 let(
850 I = ident(3),
851 dir_ind = ord(dir)-ord("X")
852 )
853 flatten([
854 for (poly = polys)
855 let( plane = plane_from_polygon(poly))
856 assert(plane,"Found non-coplanar face.")
857 let(
858 normal = point3d(plane),
859 pnormal = normal - (normal*I[dir_ind])*I[dir_ind]
860 )
861 approx(pnormal,[0,0,0]) ? [poly] :
862 let (
863 pind = max_index(v_abs(pnormal)), // project along this direction
864 otherind = 3-pind-dir_ind, // keep dir_ind and this direction
865 keep = [I[dir_ind], I[otherind]], // dir ind becomes the x dir
866 poly2d = poly*transpose(keep), // project to 2d, putting selected direction in the X position
867 poly_list = [for(p=_split_2dpolygons_at_each_x([poly2d], cuts))
868 let(
869 a = p*keep, // unproject, but pind dimension data is missing
870 ofs = outer_product((repeat(plane[3], len(a))-a*normal)/plane[pind],I[pind])
871 )
872 a+ofs] // ofs computes the missing pind dimension data and adds it back in
873 )
874 poly_list
875 ]);
876
877
878
879
880
881// Section: Turning a VNF into geometry
882
883
884// Module: vnf_polyhedron()
885// Usage:
886// vnf_polyhedron(vnf) [ATTACHMENTS];
887// vnf_polyhedron([VNF, VNF, VNF, ...]) [ATTACHMENTS];
888// Description:
889// Given a VNF structure, or a list of VNF structures, creates a polyhedron from them.
890// Arguments:
891// vnf = A VNF structure, or list of VNF structures.
892// convexity = Max number of times a line could intersect a wall of the shape.
893// extent = If true, calculate anchors by extents, rather than intersection. Default: true.
894// cp = Centerpoint for determining intersection anchors or centering the shape. Determintes the base of the anchor vector. Can be "centroid", "mean", "box" or a 3D point. Default: "centroid"
895// anchor = Translate so anchor point is at origin (0,0,0). See [anchor](attachments.scad#subsection-anchor). Default: `"origin"`
896// spin = Rotate this many degrees around the Z axis after anchor. See [spin](attachments.scad#subsection-spin). Default: `0`
897// orient = Vector to rotate top towards, after spin. See [orient](attachments.scad#subsection-orient). Default: `UP`
898// atype = Select "hull" or "intersect" anchor type. Default: "hull"
899// Anchor Types:
900// "hull" = Anchors to the virtual convex hull of the shape.
901// "intersect" = Anchors to the surface of the shape.
902// Extra Anchors:
903// "origin" = Anchor at the origin, oriented UP.
904module vnf_polyhedron(vnf, convexity=2, extent=true, cp="centroid", anchor="origin", spin=0, orient=UP, atype="hull") {
905 vnf = is_vnf_list(vnf)? vnf_join(vnf) : vnf;
906 assert(in_list(atype, _ANCHOR_TYPES), "Anchor type must be \"hull\" or \"intersect\"");
907 attachable(anchor,spin,orient, vnf=vnf, extent=atype=="hull", cp=cp) {
908 polyhedron(vnf[0], vnf[1], convexity=convexity);
909 children();
910 }
911}
912
913
914// Module: vnf_wireframe()
915// Usage:
916// vnf_wireframe(vnf, [width]);
917// Description:
918// Given a VNF, creates a wire frame ball-and-stick model of the polyhedron with a cylinder for
919// each edge and a sphere at each vertex. The width parameter specifies the width of the sticks
920// that form the wire frame and the diameter of the balls.
921// Arguments:
922// vnf = A vnf structure
923// width = width of the cylinders forming the wire frame. Default: 1
924// Example:
925// $fn=32;
926// ball = sphere(r=20, $fn=6);
927// vnf_wireframe(ball,width=1);
928// Example:
929// include <BOSL2/polyhedra.scad>
930// $fn=32;
931// cube_oct = regular_polyhedron_info("vnf",
932// name="cuboctahedron", or=20);
933// vnf_wireframe(cube_oct);
934// Example: The spheres at the vertex are imperfect at aligning with the cylinders, so especially at low $fn things look prety ugly. This is normal.
935// include <BOSL2/polyhedra.scad>
936// $fn=8;
937// octahedron = regular_polyhedron_info("vnf",
938// name="octahedron", or=20);
939// vnf_wireframe(octahedron,width=5);
940module vnf_wireframe(vnf, width=1)
941{
942 vertex = vnf[0];
943 edges = unique([for (face=vnf[1], i=idx(face))
944 sort([face[i], select(face,i+1)])
945 ]);
946 for (e=edges) extrude_from_to(vertex[e[0]],vertex[e[1]]) circle(d=width);
947 // Identify vertices actually used and draw them
948 vertused = search(count(len(vertex)), flatten(edges), 1);
949 for(i=idx(vertex)) if(vertused[i]!=[]) move(vertex[i]) sphere(d=width);
950}
951
952
953// Section: Operations on VNFs
954
955// Function: vnf_volume()
956// Usage:
957// vol = vnf_volume(vnf);
958// Description:
959// Returns the volume enclosed by the given manifold VNF. The VNF must describe a valid polyhedron with consistent face direction and
960// no holes; otherwise the results are undefined. Returns a positive volume if face direction is clockwise and a negative volume
961// if face direction is counter-clockwise.
962
963// Divide the polyhedron into tetrahedra with the origin as one vertex and sum up the signed volume.
964function vnf_volume(vnf) =
965 let(verts = vnf[0])
966 sum([
967 for(face=vnf[1], j=[1:1:len(face)-2])
968 cross(verts[face[j+1]], verts[face[j]]) * verts[face[0]]
969 ])/6;
970
971
972// Function: vnf_area()
973// Usage:
974// area = vnf_area(vnf);
975// Description:
976// Returns the surface area in any VNF by adding up the area of all its faces. The VNF need not be a manifold.
977function vnf_area(vnf) =
978 let(verts=vnf[0])
979 sum([for(face=vnf[1]) polygon_area(select(verts,face))]);
980
981
982/// Internal Function: _vnf_centroid()
983/// Usage:
984/// vol = _vnf_centroid(vnf);
985/// Description:
986/// Returns the centroid of the given manifold VNF. The VNF must describe a valid polyhedron with consistent face direction and
987/// no holes; otherwise the results are undefined.
988
989/// Divide the solid up into tetrahedra with the origin as one vertex.
990/// The centroid of a tetrahedron is the average of its vertices.
991/// The centroid of the total is the volume weighted average.
992function _vnf_centroid(vnf,eps=EPSILON) =
993 assert(is_vnf(vnf) && len(vnf[0])!=0 && len(vnf[1])!=0,"Invalid or empty VNF given to centroid")
994 let(
995 verts = vnf[0],
996 pos = sum([
997 for(face=vnf[1], j=[1:1:len(face)-2]) let(
998 v0 = verts[face[0]],
999 v1 = verts[face[j]],
1000 v2 = verts[face[j+1]],
1001 vol = cross(v2,v1)*v0
1002 )
1003 [ vol, (v0+v1+v2)*vol ]
1004 ])
1005 )
1006 assert(!approx(pos[0],0, eps), "The vnf has self-intersections.")
1007 pos[1]/pos[0]/4;
1008
1009
1010// Function: vnf_halfspace()
1011// Usage:
1012// newvnf = vnf_halfspace(plane, vnf, [closed], [boundary]);
1013// Description:
1014// Returns the intersection of the vnf with a half space. The half space is defined by
1015// plane = [A,B,C,D], taking the side where the normal [A,B,C] points: Ax+By+Cz≥D.
1016// If closed is set to false then the cut face is not included in the vnf. This could
1017// allow further extension of the vnf by join with other vnfs using {{vnf_join()}}.
1018// Note that if your given VNF has holes (missing faces) or is not a complete polyhedron
1019// then closed=true is may produce invalid results when it tries to construct closing faces
1020// on the cut plane. Set closed=false for such inputs.
1021// .
1022// If you set boundary to true then the return will be the pair [vnf,boundary] where vnf is the
1023// vnf as usual (with closed=false) and boundary is a list giving each connected component of the cut
1024// boundary surface. Each entry in boundary is a list of index values that index into the vnf vertex list (vnf[0]).
1025// This makes it possible to construct mating shapes, e.g. with {{skin()}} or {{vnf_vertex_array()}} that
1026// can be combined using {{vnf_join()}} to make a valid polyhedron.
1027// Arguments:
1028// plane = plane defining the boundary of the half space
1029// vnf = vnf to cut
1030// closed = if false do not return the cut face(s) in the returned VNF. Default: true
1031// boundary = if true return a pair [vnf,boundary] where boundary is a list of paths on the cut boundary indexed into the VNF vertex list. If boundary is true, then closed is set to false. Default: false
1032// Example(3D):
1033// vnf = cube(10,center=true);
1034// cutvnf = vnf_halfspace([-1,1,-1,0], vnf);
1035// vnf_polyhedron(cutvnf);
1036// Example(3D): Cut face has 2 components
1037// vnf = path_sweep(circle(r=4, $fn=16),
1038// circle(r=20, $fn=64),closed=true);
1039// cutvnf = vnf_halfspace([-1,1,-4,0], vnf);
1040// vnf_polyhedron(cutvnf);
1041// Example(3D): Cut face is not simply connected
1042// vnf = path_sweep(circle(r=4, $fn=16),
1043// circle(r=20, $fn=64),closed=true);
1044// cutvnf = vnf_halfspace([0,0.7,-4,0], vnf);
1045// vnf_polyhedron(cutvnf);
1046// Example(3D): Cut object has multiple components
1047// function knot(a,b,t) = // rolling knot
1048// [ a * cos (3 * t) / (1 - b* sin (2 *t)),
1049// a * sin( 3 * t) / (1 - b* sin (2 *t)),
1050// 1.8 * b * cos (2 * t) /(1 - b* sin (2 *t))];
1051// a = 0.8; b = sqrt (1 - a * a);
1052// ksteps = 400;
1053// knot_path = [for (i=[0:ksteps-1]) 50 * knot(a,b,(i/ksteps)*360)];
1054// ushape = [[-10, 0],[-10, 10],[ -7, 10],[ -7, 2],[ 7, 2],[ 7, 7],[ 10, 7],[ 10, 0]];
1055// knot=path_sweep(ushape, knot_path, closed=true, method="incremental");
1056// cut_knot = vnf_halfspace([1,0,0,0], knot);
1057// vnf_polyhedron(cut_knot);
1058// Example(VPR=[80,0,15]): Cut a sphere with an arbitrary plane
1059// vnf1=sphere(r=50, style="icosa", $fn=16);
1060// vnf2=vnf_halfspace([.8,1,-1.5,0], vnf1);
1061// vnf_polyhedron(vnf2);
1062// Example(VPR=[80,0,15]): Cut it again, but with closed=false to leave an open boundary.
1063// vnf1=sphere(r=50, style="icosa", $fn=16);
1064// vnf2=vnf_halfspace([.8,1,-1.5,0], vnf1);
1065// vnf3=vnf_halfspace([0,0,-1,0], vnf2, closed=false);
1066// vnf_polyhedron(vnf3);
1067// Example(VPR=[80,0,15]): Use {vnf_join()} to combine with a mating vnf, in this case a reflection of the part we made.
1068// vnf1=sphere(r=50, style="icosa", $fn=16);
1069// vnf2=vnf_halfspace([.8,1,-1.5,0], vnf1);
1070// vnf3=vnf_halfspace([0,0,-1,0], vnf2, closed=false);
1071// vnf4=vnf_join([vnf3, zflip(vnf3,1)]);
1072// vnf_polyhedron(vnf4);
1073// Example: When the input VNF is a surface with a boundary, if you use the default setting closed=true, then vnf_halfspace() tries to construct closing faces from the edges created by the cut. These faces may be invalid, for example if the cut points are collinear. In this example the constructed face is a valid face.
1074// include <BOSL2/beziers.scad>
1075// patch=[
1076// [[10,-10,0],[1,-1,0],[-1,-1,0],[-10,-10,0]],
1077// [[10,-10,20],[1,-1,20],[-1,-1,20],[-10,-10,20]]
1078// ];
1079// vnf=bezier_vnf(patch);
1080// vnfcut = vnf_halfspace([-.8,0,-1,-14],vnf);
1081// vnf_polyhedron(vnfcut);
1082// Example: Setting closed to false eliminates this (possibly invalid) face:
1083// include <BOSL2/beziers.scad>
1084// patch=[
1085// [[10,-10,0],[1,-1,0],[-1,-1,0],[-10,-10,0]],
1086// [[10,-10,20],[1,-1,20],[-1,-1,20],[-10,-10,20]]
1087// ];
1088// vnf=bezier_vnf(patch);
1089// vnfcut = vnf_halfspace([-.8,0,-1,-14],vnf,closed=false);
1090// vnf_polyhedron(vnfcut);
1091// Example: If boundary=true then the return is a list with the VNF and boundary data.
1092// vnf = path_sweep(circle(r=4, $fn=16),
1093// circle(r=20, $fn=64),closed=true);
1094// cut_bnd = vnf_halfspace([-1,1,-4,0], vnf, boundary=true);*/
1095// cutvnf = cut_bnd[0];
1096// boundary = [for(b=cut_bnd[1]) select(cutvnf[0],b)];
1097// vnf_polyhedron(cutvnf);
1098// stroke(boundary,color="red");
1099function vnf_halfspace(plane, vnf, closed=true, boundary=false) =
1100 assert(_valid_plane(plane), "Invalid plane")
1101 assert(is_vnf(vnf), "Invalid vnf")
1102 let(
1103 inside = [for(x=vnf[0]) plane*[each x,-1] >= -EPSILON ? 1 : 0],
1104 vertexmap = [0,each cumsum(inside)],
1105 faces_edges_vertices = _vnfcut(plane, vnf[0],vertexmap,inside, vnf[1], last(vertexmap)),
1106 newvert = concat(bselect(vnf[0],inside), faces_edges_vertices[2])
1107 )
1108 closed==false && !boundary ? [newvert, faces_edges_vertices[0]]
1109 : let(
1110 allpaths = _assemble_paths(newvert, faces_edges_vertices[1]),
1111 newpaths = [for(p=allpaths) if (len(p)>=3) p
1112 else assert(approx(p[0],p[1]),"Orphan edge found when assembling cut edges.")
1113 ]
1114 )
1115 boundary ? [[newvert, faces_edges_vertices[0]], newpaths]
1116 : len(newpaths)<=1 ? [newvert, concat(faces_edges_vertices[0], newpaths)]
1117 : let(
1118 M = project_plane(plane),
1119 faceregion = [for(path=newpaths) path2d(apply(M,select(newvert,path)))],
1120 facevnf = vnf_from_region(faceregion,transform=rot_inverse(M),reverse=true)
1121 )
1122 vnf_join([[newvert, faces_edges_vertices[0]], facevnf]);
1123
1124function _assemble_paths(vertices, edges, paths=[],i=0) =
1125 i==len(edges) ? paths :
1126 norm(vertices[edges[i][0]]-vertices[edges[i][1]])<EPSILON ? _assemble_paths(vertices,edges,paths,i+1) :
1127 let( // Find paths that connects on left side and right side of the edges (if one exists)
1128 left = [for(j=idx(paths)) if (approx(vertices[last(paths[j])],vertices[edges[i][0]])) j],
1129 right = [for(j=idx(paths)) if (approx(vertices[edges[i][1]],vertices[paths[j][0]])) j]
1130 )
1131 assert(len(left)<=1 && len(right)<=1)
1132 let(
1133 keep_path = list_remove(paths,concat(left,right)),
1134 update_path = left==[] && right==[] ? edges[i]
1135 : left==[] ? concat([edges[i][0]],paths[right[0]])
1136 : right==[] ? concat(paths[left[0]],[edges[i][1]])
1137 : left != right ? concat(paths[left[0]], paths[right[0]])
1138 : paths[left[0]]
1139 )
1140 _assemble_paths(vertices, edges, concat(keep_path, [update_path]), i+1);
1141
1142
1143function _vnfcut(plane, vertices, vertexmap, inside, faces, vertcount, newfaces=[], newedges=[], newvertices=[], i=0) =
1144 i==len(faces) ? [newfaces, newedges, newvertices] :
1145 let(
1146 pts_inside = select(inside,faces[i])
1147 )
1148 all(pts_inside) ? _vnfcut(plane, vertices, vertexmap, inside, faces, vertcount,
1149 concat(newfaces, [select(vertexmap,faces[i])]), newedges, newvertices, i+1):
1150 !any(pts_inside) ? _vnfcut(plane, vertices, vertexmap,inside, faces, vertcount, newfaces, newedges, newvertices, i+1):
1151 let(
1152 first = search([[1,0]],pair(pts_inside,wrap=true),0)[0],
1153 second = search([[0,1]],pair(pts_inside,wrap=true),0)[0]
1154 )
1155 assert(len(first)==1 && len(second)==1, "Found concave face in VNF. Run vnf_triangulate first to ensure convex faces.")
1156 let(
1157 newface = [each select(vertexmap,select(faces[i],second[0]+1,first[0])),vertcount, vertcount+1],
1158 newvert = [plane_line_intersection(plane, select(vertices,select(faces[i],first[0],first[0]+1)),eps=0),
1159 plane_line_intersection(plane, select(vertices,select(faces[i],second[0],second[0]+1)),eps=0)]
1160 )
1161 true //!approx(newvert[0],newvert[1])
1162 ? _vnfcut(plane, vertices, vertexmap, inside, faces, vertcount+2,
1163 concat(newfaces, [newface]), concat(newedges,[[vertcount+1,vertcount]]),concat(newvertices,newvert),i+1)
1164 :len(newface)>3
1165 ? _vnfcut(plane, vertices, vertexmap, inside, faces, vertcount+1,
1166 concat(newfaces, [list_head(newface)]), newedges,concat(newvertices,[newvert[0]]),i+1)
1167 :
1168 _vnfcut(plane, vertices, vertexmap, inside, faces, vertcount,newfaces, newedges, newvert, i+1);
1169
1170
1171
1172
1173function _triangulate_planar_convex_polygons(polys) =
1174 polys==[]? [] :
1175 let(
1176 tris = [for (poly=polys) if (len(poly)==3) poly],
1177 bigs = [for (poly=polys) if (len(poly)>3) poly],
1178 newtris = [for (poly=bigs) select(poly,-2,0)],
1179 newbigs = [for (poly=bigs) select(poly,0,-2)],
1180 newtris2 = _triangulate_planar_convex_polygons(newbigs),
1181 outtris = concat(tris, newtris, newtris2)
1182 ) outtris;
1183
1184//**
1185// this function may produce degenerate triangles:
1186// _triangulate_planar_convex_polygons([ [for(i=[0:1]) [i,i],
1187// [1,-1], [-1,-1],
1188// for(i=[-1:0]) [i,i] ] ] )
1189// == [[[-1, -1], [ 0, 0], [0, 0]]
1190// [[-1, -1], [-1, -1], [0, 0]]
1191// [[ 1, -1], [-1, -1], [0, 0]]
1192// [[ 0, 0], [ 1, 1], [1, -1]] ]
1193//
1194
1195// Function: vnf_bend()
1196// Usage:
1197// bentvnf = vnf_bend(vnf,r|d=,[axis=]);
1198// Description:
1199// Bend a VNF around the X, Y or Z axis, splitting up faces as necessary. Returns the bent
1200// VNF. For bending around the Z axis the input VNF must not cross the Y=0 plane. For bending
1201// around the X or Y axes the VNF must not cross the Z=0 plane. Note that if you wrap a VNF all the way around
1202// it may intersect itself, which produces an invalid polyhedron. It is your responsibility to
1203// avoid this situation. The 1:1
1204// radius is where the curved length of the bent VNF matches the length of the original VNF. If the
1205// `r` or `d` arguments are given, then they will specify the 1:1 radius or diameter. If they are
1206// not given, then the 1:1 radius will be defined by the distance of the furthest vertex in the
1207// original VNF from the Z=0 plane. You can adjust the granularity of the bend using the standard
1208// `$fa`, `$fs`, and `$fn` variables.
1209// Arguments:
1210// vnf = The original VNF to bend.
1211// r = If given, the radius where the size of the original shape is the same as in the original.
1212// ---
1213// d = If given, the diameter where the size of the original shape is the same as in the original.
1214// axis = The axis to wrap around. "X", "Y", or "Z". Default: "Z"
1215// Example(3D):
1216// vnf0 = cube([100,40,10], center=true);
1217// vnf1 = up(50, p=vnf0);
1218// vnf2 = down(50, p=vnf0);
1219// bent1 = vnf_bend(vnf1, axis="Y");
1220// bent2 = vnf_bend(vnf2, axis="Y");
1221// vnf_polyhedron([bent1,bent2]);
1222// Example(3D):
1223// vnf0 = linear_sweep(star(n=5,step=2,d=100), height=10);
1224// vnf1 = up(50, p=vnf0);
1225// vnf2 = down(50, p=vnf0);
1226// bent1 = vnf_bend(vnf1, axis="Y");
1227// bent2 = vnf_bend(vnf2, axis="Y");
1228// vnf_polyhedron([bent1,bent2]);
1229// Example(3D):
1230// rgn = union(rect([100,20]),
1231// rect([20,100]));
1232// vnf0 = linear_sweep(zrot(45,p=rgn), height=10);
1233// vnf1 = up(50, p=vnf0);
1234// vnf2 = down(50, p=vnf0);
1235// bent1 = vnf_bend(vnf1, axis="Y");
1236// bent2 = vnf_bend(vnf2, axis="Y");
1237// vnf_polyhedron([bent1,bent2]);
1238// Example(3D): Bending Around X Axis.
1239// rgnr = union(
1240// rect([20,100]),
1241// back(50, p=trapezoid(w1=40, w2=0, h=20, anchor=FRONT))
1242// );
1243// vnf0 = xrot(00,p=linear_sweep(rgnr, height=10));
1244// vnf1 = up(50, p=vnf0);
1245// #vnf_polyhedron(vnf1);
1246// bent1 = vnf_bend(vnf1, axis="X");
1247// vnf_polyhedron([bent1]);
1248// Example(3D): Bending Around Y Axis.
1249// rgn = union(
1250// rect([20,100]),
1251// back(50, p=trapezoid(w1=40, w2=0, h=20, anchor=FRONT))
1252// );
1253// rgnr = zrot(-90, p=rgn);
1254// vnf0 = xrot(00,p=linear_sweep(rgnr, height=10));
1255// vnf1 = up(50, p=vnf0);
1256// #vnf_polyhedron(vnf1);
1257// bent1 = vnf_bend(vnf1, axis="Y");
1258// vnf_polyhedron([bent1]);
1259// Example(3D): Bending Around Z Axis.
1260// rgn = union(
1261// rect([20,100]),
1262// back(50, p=trapezoid(w1=40, w2=0, h=20, anchor=FRONT))
1263// );
1264// rgnr = zrot(90, p=rgn);
1265// vnf0 = xrot(90,p=linear_sweep(rgnr, height=10));
1266// vnf1 = fwd(50, p=vnf0);
1267// #vnf_polyhedron(vnf1);
1268// bent1 = vnf_bend(vnf1, axis="Z");
1269// vnf_polyhedron([bent1]);
1270// Example(3D): Bending more than once around the cylinder
1271// $fn=32;
1272// vnf = apply(fwd(5)*yrot(30),cube([100,2,5],center=true));
1273// bent = vnf_bend(vnf, axis="Z");
1274// vnf_polyhedron(bent);
1275function vnf_bend(vnf,r,d,axis="Z") =
1276 let(
1277 chk_axis = assert(in_list(axis,["X","Y","Z"])),
1278 verts = vnf[0],
1279 bounds = pointlist_bounds(verts),
1280 bmin = bounds[0],
1281 bmax = bounds[1],
1282 dflt = axis=="Z"?
1283 max(abs(bmax.y), abs(bmin.y)) :
1284 max(abs(bmax.z), abs(bmin.z)),
1285 r = get_radius(r=r,d=d,dflt=dflt),
1286 extent = axis=="X" ? [bmin.y, bmax.y] : [bmin.x, bmax.x]
1287 )
1288 let(
1289 span_chk = axis=="Z"?
1290 assert(bmin.y > 0 || bmax.y < 0, "Entire shape MUST be completely in front of or behind y=0.") :
1291 assert(bmin.z > 0 || bmax.z < 0, "Entire shape MUST be completely above or below z=0."),
1292 steps = 1+ceil(segs(r) * (extent[1]-extent[0])/(2*PI*r)),
1293 step = (extent[1]-extent[0]) / steps,
1294 bend_at = [for(i = [1:1:steps-1]) i*step+extent[0]],
1295 slicedir = axis=="X"? "Y" : "X", // slice in y dir for X axis case, and x dir otherwise
1296 sliced = vnf_slice(vnf, slicedir, bend_at),
1297 coord = axis=="X" ? [0,sign(bmax.z),0] : axis=="Y" ? [sign(bmax.z),0,0] : [sign(bmax.y),0,0],
1298 new_vert = [for(p=sliced[0])
1299 let(a=coord*p*180/(PI*r))
1300 axis=="X"? [p.x, p.z*sin(a), p.z*cos(a)] :
1301 axis=="Y"? [p.z*sin(a), p.y, p.z*cos(a)] :
1302 [p.y*sin(a), p.y*cos(a), p.z]]
1303 ) [new_vert,sliced[1]];
1304
1305
1306// Section: Debugging Polyhedrons
1307
1308/// Internal Module: _show_vertices()
1309/// Usage:
1310/// _show_vertices(vertices, [size], [filter=])
1311/// Description:
1312/// Draws all the vertices in an array, at their 3D position, numbered by their
1313/// position in the vertex array. Also draws any children of this module with
1314/// transparency.
1315/// Arguments:
1316/// vertices = Array of point vertices.
1317/// size = The size of the text used to label the vertices. Default: 1
1318/// Example:
1319/// verts = [for (z=[-10,10], y=[-10,10], x=[-10,10]) [x,y,z]];
1320/// faces = [[0,1,2], [1,3,2], [0,4,5], [0,5,1], [1,5,7], [1,7,3], [3,7,6], [3,6,2], [2,6,4], [2,4,0], [4,6,7], [4,7,5]];
1321/// _show_vertices(vertices=verts, size=2) {
1322/// polyhedron(points=verts, faces=faces);
1323/// }
1324module _show_vertices(vertices, size=1, filter) {
1325 color("blue") {
1326 dups = vector_search(vertices, EPSILON, vertices);
1327 for (ind = dups) {
1328 if (is_undef(filter) || any(ind, filter)) {
1329 numstr = str_join([for(i=ind) str(i)],",");
1330 v = vertices[ind[0]];
1331 translate(v) {
1332 rot($vpr) back(size/8){
1333 linear_extrude(height=size/10, center=true, convexity=10) {
1334 text(text=numstr, size=size, halign="center");
1335 }
1336 }
1337 sphere(size/10);
1338 }
1339 }
1340 }
1341 }
1342}
1343
1344
1345/// Internal Module: _show_faces()
1346/// Usage:
1347/// _show_faces(vertices, faces, [size=], [filter=]);
1348/// Description:
1349/// Draws all the vertices at their 3D position, numbered in blue by their
1350/// position in the vertex array. Each face will have their face number drawn
1351/// in red, aligned with the center of face. All children of this module are drawn
1352/// with transparency.
1353/// Arguments:
1354/// vertices = Array of point vertices.
1355/// faces = Array of faces by vertex numbers.
1356/// size = The size of the text used to label the faces and vertices. Default: 1
1357/// Example(EdgesMed):
1358/// verts = [for (z=[-10,10], y=[-10,10], x=[-10,10]) [x,y,z]];
1359/// faces = [[0,1,2], [1,3,2], [0,4,5], [0,5,1], [1,5,7], [1,7,3], [3,7,6], [3,6,2], [2,6,4], [2,4,0], [4,6,7], [4,7,5]];
1360/// _show_faces(vertices=verts, faces=faces, size=2) {
1361/// polyhedron(points=verts, faces=faces);
1362/// }
1363module _show_faces(vertices, faces, size=1, filter) {
1364 vlen = len(vertices);
1365 color("red") {
1366 for (i = [0:1:len(faces)-1]) {
1367 face = faces[i];
1368 if (face[0] < 0 || face[1] < 0 || face[2] < 0 || face[0] >= vlen || face[1] >= vlen || face[2] >= vlen) {
1369 echo("BAD FACE: ", vlen=vlen, face=face);
1370 } else if (is_undef(filter) || any(face,filter)) {
1371 verts = select(vertices,face);
1372 c = mean(verts);
1373 v0 = verts[0];
1374 v1 = verts[1];
1375 v2 = verts[2];
1376 dv0 = unit(v1 - v0);
1377 dv1 = unit(v2 - v0);
1378 nrm0 = cross(dv0, dv1);
1379 nrm1 = UP;
1380 axis = vector_axis(nrm0, nrm1);
1381 ang = vector_angle(nrm0, nrm1);
1382 theta = atan2(nrm0[1], nrm0[0]);
1383 translate(c) {
1384 rotate(a=180-ang, v=axis) {
1385 zrot(theta-90)
1386 linear_extrude(height=size/10, center=true, convexity=10) {
1387 union() {
1388 text(text=str(i), size=size, halign="center");
1389 text(text=str("_"), size=size, halign="center");
1390 }
1391 }
1392 }
1393 }
1394 }
1395 }
1396 }
1397}
1398
1399
1400
1401// Module: debug_vnf()
1402// Usage:
1403// debug_vnf(vnfs, [faces=], [vertices=], [opacity=], [size=], [convexity=], [filter=]);
1404// Description:
1405// A drop-in module to replace `vnf_polyhedron()` to help debug vertices and faces.
1406// Draws all the vertices at their 3D position, numbered in blue by their
1407// position in the vertex array. Each face will have its face number drawn
1408// in red, aligned with the center of face. All given faces are drawn with
1409// transparency. All children of this module are drawn with transparency.
1410// Works best with Thrown-Together preview mode, to see reversed faces.
1411// You can set opacity to 0 if you want to supress the display of the polyhedron faces.
1412// .
1413// The vertex numbers are shown rotated to face you. As you rotate your polyhedron you
1414// can rerun the preview to display them oriented for viewing from a different viewpoint.
1415// Topics: Polyhedra, Debugging
1416// Arguments:
1417// vnf = vnf to display
1418// ---
1419// faces = if true display face numbers. Default: true
1420// vertices = if true display vertex numbers. Default: true
1421// opacity = Opacity of the polyhedron faces. Default: 0.5
1422// convexity = The max number of walls a ray can pass through the given polygon paths.
1423// size = The size of the text used to label the faces and vertices. Default: 1
1424// filter = If given a function literal of signature `function(i)`, will only show labels for vertices and faces that have a vertex index that gets a true result from that function. Default: no filter.
1425// Example(EdgesMed):
1426// verts = [for (z=[-10,10], a=[0:120:359.9]) [10*cos(a),10*sin(a),z]];
1427// faces = [[0,1,2], [5,4,3], [0,3,4], [0,4,1], [1,4,5], [1,5,2], [2,5,3], [2,3,0]];
1428// debug_vnf([verts,faces], size=2);
1429module debug_vnf(vnf, faces=true, vertices=true, opacity=0.5, size=1, convexity=6, filter ) {
1430 no_children($children);
1431 if (faces)
1432 _show_faces(vertices=vnf[0], faces=vnf[1], size=size, filter=filter);
1433 if (vertices)
1434 _show_vertices(vertices=vnf[0], size=size, filter=filter);
1435 if (opacity > 0)
1436 color([0.2, 1.0, 0, opacity])
1437 vnf_polyhedron(vnf,convexity=convexity);
1438}
1439
1440
1441// Function&Module: vnf_validate()
1442// Usage: As Function
1443// fails = vnf_validate(vnf);
1444// Usage: As Module
1445// vnf_validate(vnf, [size], [show_warns=], [check_isects=], [opacity=], [adjacent=], [label_verts=], [label_faces=], [wireframe=]);
1446// Description:
1447// When called as a function, returns a list of non-manifold errors with the given VNF.
1448// Each error has the format `[ERR_OR_WARN,CODE,MESG,POINTS,COLOR]`.
1449// When called as a module, echoes the non-manifold errors to the console, and color hilites the
1450// bad edges and vertices, overlaid on a transparent gray polyhedron of the VNF.
1451// .
1452// Currently checks for these problems:
1453// .
1454// Type | Color | Code | Message
1455// ------- | -------- | ------------ | ---------------------------------
1456// WARNING | Yellow | BIG_FACE | Face has more than 3 vertices, and may confuse CGAL.
1457// WARNING | Brown | NULL_FACE | Face has zero area.
1458// ERROR | Cyan | NONPLANAR | Face vertices are not coplanar.
1459// ERROR | Brown | DUP_FACE | Multiple instances of the same face.
1460// ERROR | Orange | MULTCONN | Multiply Connected Geometry. Too many faces attached at Edge.
1461// ERROR | Violet | REVERSAL | Faces reverse across edge.
1462// ERROR | Red | T_JUNCTION | Vertex is mid-edge on another Face.
1463// ERROR | Blue | FACE_ISECT | Faces intersect.
1464// ERROR | Magenta | HOLE_EDGE | Edge bounds Hole.
1465// .
1466// Still to implement:
1467// - Overlapping coplanar faces.
1468// Arguments:
1469// vnf = The VNF to validate.
1470// size = The width of the lines and diameter of points used to highlight edges and vertices. Module only. Default: 1
1471// ---
1472// show_warns = If true show warnings for non-triangular faces. Default: true
1473// check_isects = If true, performs slow checks for intersecting faces. Default: false
1474// opacity = The opacity level to show the polyhedron itself with. (Module only) Default: 0.67
1475// label_verts = If true, shows labels at each vertex that show the vertex number. (Module only) Default: false
1476// label_faces = If true, shows labels at the center of each face that show the face number. (Module only) Default: false
1477// wireframe = If true, shows edges more clearly so you can see them in Thrown Together mode. (Module only) Default: false
1478// adjacent = If true, only display faces adjacent to a vertex listed in the errors. (Module only) Default: false
1479// Example(3D,Edges): BIG_FACE Warnings; Faces with More Than 3 Vertices. CGAL often will fail to accept that a face is planar after a rotation, if it has more than 3 vertices.
1480// vnf = skin([
1481// path3d(regular_ngon(n=3, d=100),0),
1482// path3d(regular_ngon(n=5, d=100),100)
1483// ], slices=0, caps=true, method="tangent");
1484// vnf_validate(vnf);
1485// Example(3D,Edges): NONPLANAR Errors; Face Vertices are Not Coplanar
1486// a = [ 0, 0,-50];
1487// b = [-50,-50, 50];
1488// c = [-50, 50, 50];
1489// d = [ 50, 50, 60];
1490// e = [ 50,-50, 50];
1491// vnf = vnf_from_polygons([
1492// [a, b, e], [a, c, b], [a, d, c], [a, e, d], [b, c, d, e]
1493// ]);
1494// vnf_validate(vnf);
1495// Example(3D,Edges): MULTCONN Errors; More Than Two Faces Attached to the Same Edge. This confuses CGAL, and can lead to failed renders.
1496// vnf = vnf_triangulate(linear_sweep(union(square(50), square(50,anchor=BACK+RIGHT)), height=50));
1497// vnf_validate(vnf);
1498// Example(3D,Edges): REVERSAL Errors; Faces Reversed Across Edge
1499// vnf1 = skin([
1500// path3d(square(100,center=true),0),
1501// path3d(square(100,center=true),100),
1502// ], slices=0, caps=false);
1503// vnf = vnf_join([vnf1, vnf_from_polygons([
1504// [[-50,-50, 0], [ 50, 50, 0], [-50, 50, 0]],
1505// [[-50,-50, 0], [ 50,-50, 0], [ 50, 50, 0]],
1506// [[-50,-50,100], [-50, 50,100], [ 50, 50,100]],
1507// [[-50,-50,100], [ 50,-50,100], [ 50, 50,100]],
1508// ])]);
1509// vnf_validate(vnf);
1510// Example(3D,Edges): T_JUNCTION Errors; Vertex is Mid-Edge on Another Face.
1511// vnf = [
1512// [
1513// each path3d(square(100,center=true),0),
1514// each path3d(square(100,center=true),100),
1515// [0,-50,100],
1516// ], [
1517// [0,2,1], [0,3,2], [0,8,4], [0,1,8], [1,5,8],
1518// [0,4,3], [4,7,3], [1,2,5], [2,6,5], [3,7,6],
1519// [3,6,2], [4,5,6], [4,6,7],
1520// ]
1521// ];
1522// vnf_validate(vnf);
1523// Example(3D,Edges): FACE_ISECT Errors; Faces Intersect
1524// vnf = vnf_join([
1525// vnf_triangulate(linear_sweep(square(100,center=true), height=100)),
1526// move([75,35,30],p=vnf_triangulate(linear_sweep(square(100,center=true), height=100)))
1527// ]);
1528// vnf_validate(vnf,size=2,check_isects=true);
1529// Example(3D,Edges): HOLE_EDGE Errors; Edges Adjacent to Holes.
1530// vnf = skin([
1531// path3d(regular_ngon(n=4, d=100),0),
1532// path3d(regular_ngon(n=5, d=100),100)
1533// ], slices=0, caps=false);
1534// vnf_validate(vnf,size=2);
1535function vnf_validate(vnf, show_warns=true, check_isects=false) =
1536 assert(is_vnf(vnf), "Invalid VNF")
1537 let(
1538 vnf = vnf_merge_points(vnf),
1539 varr = vnf[0],
1540 faces = vnf[1],
1541 lvarr = len(varr),
1542 edges = sort([
1543 for (face=faces, edge=pair(face,true))
1544 edge[0]<edge[1]? edge : [edge[1],edge[0]]
1545 ]),
1546 dfaces = [
1547 for (face=faces) let(
1548 face=deduplicate_indexed(varr,face,closed=true)
1549 ) if(len(face)>=3)
1550 face
1551 ],
1552 face_areas = [
1553 for (face = faces)
1554 len(face) < 3? 0 :
1555 polygon_area([for (k=face) varr[k]])
1556 ],
1557 edgecnts = unique_count(edges),
1558 uniq_edges = edgecnts[0],
1559 issues = []
1560 )
1561 let(
1562 big_faces = !show_warns? [] : [
1563 for (face = faces)
1564 if (len(face) > 3)
1565 _vnf_validate_err("BIG_FACE", face)
1566 ],
1567 null_faces = !show_warns? [] : [
1568 for (i = idx(faces)) let(
1569 face = faces[i],
1570 area = face_areas[i]
1571 )
1572 if (is_num(area) && abs(area) < EPSILON)
1573 _vnf_validate_err("NULL_FACE", face)
1574 ],
1575 issues = concat(big_faces, null_faces)
1576 )
1577 let(
1578 bad_indices = [
1579 for (face = faces, idx = face)
1580 if (idx < 0 || idx >= lvarr)
1581 _vnf_validate_err("BAD_INDEX", [idx])
1582 ],
1583 issues = concat(issues, bad_indices)
1584 ) bad_indices? issues :
1585 let(
1586 repeated_faces = [
1587 for (i=idx(dfaces), j=idx(dfaces))
1588 if (i!=j) let(
1589 face1 = dfaces[i],
1590 face2 = dfaces[j]
1591 ) if (min(face1) == min(face2)) let(
1592 min1 = min_index(face1),
1593 min2 = min_index(face2)
1594 ) if (min1 == min2) let(
1595 sface1 = list_rotate(face1,min1),
1596 sface2 = list_rotate(face2,min2)
1597 ) if (sface1 == sface2)
1598 _vnf_validate_err("DUP_FACE", sface1)
1599 ],
1600 issues = concat(issues, repeated_faces)
1601 ) repeated_faces? issues :
1602 let(
1603 multconn_edges = unique([
1604 for (i = idx(uniq_edges))
1605 if (edgecnts[1][i]>2)
1606 _vnf_validate_err("MULTCONN", uniq_edges[i])
1607 ]),
1608 issues = concat(issues, multconn_edges)
1609 ) multconn_edges? issues :
1610 let(
1611 reversals = unique([
1612 for(i = idx(dfaces), j = idx(dfaces)) if(i != j)
1613 for(edge1 = pair(faces[i],true))
1614 for(edge2 = pair(faces[j],true))
1615 if(edge1 == edge2) // Valid adjacent faces will never have the same vertex ordering.
1616 if(_edge_not_reported(edge1, varr, multconn_edges))
1617 _vnf_validate_err("REVERSAL", edge1)
1618 ]),
1619 issues = concat(issues, reversals)
1620 ) reversals? issues :
1621 let(
1622 t_juncts = unique([
1623 for (v=idx(varr), edge=uniq_edges) let(
1624 ia = edge[0],
1625 ib = v,
1626 ic = edge[1]
1627 )
1628 if (ia!=ib && ib!=ic && ia!=ic) let(
1629 a = varr[ia],
1630 b = varr[ib],
1631 c = varr[ic]
1632 )
1633 if (!approx(a,b) && !approx(b,c) && !approx(a,c)) let(
1634 pt = line_closest_point([a,c],b,SEGMENT)
1635 )
1636 if (approx(pt,b))
1637 _vnf_validate_err("T_JUNCTION", [ib])
1638 ]),
1639 issues = concat(issues, t_juncts)
1640 ) t_juncts? issues :
1641 let(
1642 isect_faces = !check_isects? [] : unique([
1643 for (i = [0:1:len(faces)-2]) let(
1644 f1 = faces[i],
1645 poly1 = select(varr, faces[i]),
1646 plane1 = plane3pt(poly1[0], poly1[1], poly1[2]),
1647 normal1 = [plane1[0], plane1[1], plane1[2]]
1648 )
1649 for (j = [i+1:1:len(faces)-1]) let(
1650 f2 = faces[j],
1651 poly2 = select(varr, f2),
1652 val = poly2 * normal1
1653 )
1654 if( min(val)<=plane1[3] && max(val)>=plane1[3] ) let(
1655 plane2 = plane_from_polygon(poly2),
1656 normal2 = [plane2[0], plane2[1], plane2[2]],
1657 val = poly1 * normal2
1658 )
1659 if( min(val)<=plane2[3] && max(val)>=plane2[3] ) let(
1660 shared_edges = [
1661 for (edge1 = pair(f1, true), edge2 = pair(f2, true))
1662 if (edge1 == [edge2[1], edge2[0]]) 1
1663 ]
1664 )
1665 if (!shared_edges) let(
1666 line = plane_intersection(plane1, plane2)
1667 )
1668 if (!is_undef(line)) let(
1669 isects = polygon_line_intersection(poly1, line)
1670 )
1671 if (!is_undef(isects))
1672 for (isect = isects)
1673 if (len(isect) > 1) let(
1674 isects2 = polygon_line_intersection(poly2, isect, bounded=true)
1675 )
1676 if (!is_undef(isects2))
1677 for (seg = isects2)
1678 if (seg[0] != seg[1])
1679 _vnf_validate_err("FACE_ISECT", seg)
1680 ]),
1681 issues = concat(issues, isect_faces)
1682 ) isect_faces? issues :
1683 let(
1684 hole_edges = unique([
1685 for (i=idx(uniq_edges))
1686 if (edgecnts[1][i]<2)
1687 if (_pts_not_reported(uniq_edges[i], varr, t_juncts))
1688 if (_pts_not_reported(uniq_edges[i], varr, isect_faces))
1689 _vnf_validate_err("HOLE_EDGE", uniq_edges[i])
1690 ]),
1691 issues = concat(issues, hole_edges)
1692 ) hole_edges? issues :
1693 let(
1694 nonplanars = unique([
1695 for (i = idx(faces)) let(
1696 face = faces[i],
1697 area = face_areas[i],
1698 faceverts = [for (k=face) varr[k]]
1699 )
1700 if (is_num(area) && abs(area) > EPSILON)
1701 if (!is_coplanar(faceverts))
1702 _vnf_validate_err("NONPLANAR", face)
1703 ]),
1704 issues = concat(issues, nonplanars)
1705 ) issues;
1706
1707
1708_vnf_validate_errs = [
1709 ["BIG_FACE", "WARNING", "cyan", "Face has more than 3 vertices, and may confuse CGAL"],
1710 ["NULL_FACE", "WARNING", "blue", "Face has zero area."],
1711 ["BAD_INDEX", "ERROR", "cyan", "Invalid face vertex index."],
1712 ["NONPLANAR", "ERROR", "yellow", "Face vertices are not coplanar"],
1713 ["DUP_FACE", "ERROR", "brown", "Multiple instances of the same face."],
1714 ["MULTCONN", "ERROR", "orange", "Multiply Connected Geometry. Too many faces attached at Edge"],
1715 ["REVERSAL", "ERROR", "violet", "Faces Reverse Across Edge"],
1716 ["T_JUNCTION", "ERROR", "magenta", "Vertex is mid-edge on another Face"],
1717 ["FACE_ISECT", "ERROR", "brown", "Faces intersect"],
1718 ["HOLE_EDGE", "ERROR", "red", "Edge bounds Hole"]
1719];
1720
1721
1722function _vnf_validate_err(name, extra) =
1723 let(
1724 info = [for (x = _vnf_validate_errs) if (x[0] == name) x][0]
1725 ) concat(info, [extra]);
1726
1727
1728function _pts_not_reported(pts, varr, reports) =
1729 [
1730 for (i = pts, report = reports, pt = report[3])
1731 if (varr[i] == pt) 1
1732 ] == [];
1733
1734
1735function _edge_not_reported(edge, varr, reports) =
1736 let(
1737 edge = sort([for (i=edge) varr[i]])
1738 ) [
1739 for (report = reports) let(
1740 pts = sort(report[3])
1741 ) if (len(pts)==2 && edge == pts) 1
1742 ] == [];
1743
1744
1745module vnf_validate(vnf, size=1, show_warns=true, check_isects=false, opacity=0.67, adjacent=false, label_verts=false, label_faces=false, wireframe=false) {
1746 no_children($children);
1747 verts = vnf[0];
1748 faults = vnf_validate(
1749 vnf, show_warns=show_warns,
1750 check_isects=check_isects
1751 );
1752 if (!faults) {
1753 echo("VNF appears valid.");
1754 }
1755 for (fault = faults) {
1756 err = fault[0];
1757 typ = fault[1];
1758 clr = fault[2];
1759 msg = fault[3];
1760 idxs = fault[4];
1761 pts = [for (i=idxs) if(is_finite(i) && i>=0 && i<len(verts)) verts[i]];
1762 echo(str(typ, " ", err, " (", clr ,"): ", msg, " at ", pts, " indices: ", idxs));
1763 color(clr) {
1764 if (is_vector(pts[0])) {
1765 if (len(pts)==2) {
1766 stroke(pts, width=size, closed=true, endcaps="butt", $fn=8);
1767 } else if (len(pts)>2) {
1768 stroke(pts, width=size, closed=true, $fn=8);
1769 polyhedron(pts,[[for (i=idx(pts)) i]]);
1770 } else {
1771 move_copies(pts) sphere(d=size*3, $fn=18);
1772 }
1773 }
1774 }
1775 }
1776 badverts = unique([for (fault=faults) each fault[4]]);
1777 badverts2 = unique([for (j=idx(verts), i=badverts) if (i!=j && verts[i]==verts[j]) j]);
1778 all_badverts = unique(concat(badverts, badverts2));
1779 adjacent = !faults? false : adjacent;
1780 filter_fn = !adjacent? undef : function(i) in_list(i,all_badverts);
1781 adj_vnf = !adjacent? vnf : [
1782 verts, [for (face=vnf[1]) if (any(face,filter_fn)) face]
1783 ];
1784 if (wireframe) {
1785 vnf_wireframe(adj_vnf, width=size*0.25);
1786 }
1787 if (label_verts) {
1788 debug_vnf(adj_vnf, size=size*3, opacity=0, faces=false, vertices=true, filter=filter_fn);
1789 }
1790 if (label_faces) {
1791 debug_vnf(vnf, size=size*3, opacity=0, faces=true, vertices=false, filter=filter_fn);
1792 }
1793 if (opacity > 0) {
1794 color([0.5,1,0.5,opacity]) vnf_polyhedron(adj_vnf);
1795 }
1796}
1797
1798
1799
1800// vim: expandtab tabstop=4 shiftwidth=4 softtabstop=4 nowrap