library(rgl) open3d(windowRect = c(50, 50, 1050, 1050)) rgl.bg("white") par3d(antialias = 8) rgl.viewpoint(theta = 35, phi = 20, fov = 0, zoom = 0.9) clear3d() plot3d(NA, xlim=c(0,5), ylim=c(0,5), zlim=c(0,5), type="n", box=FALSE, axes=FALSE, xlab="", ylab="", zlab="") aspect3d(1, 1, 1) # Eixos lines3d(c(0,5), c(0,0), c(0,0), col="black", lwd=3) lines3d(c(0,0), c(0,5), c(0,0), col="black", lwd=3) lines3d(c(0,0), c(0,0), c(0,5), col="black", lwd=3) # 1) Função para linha 3D pontilhada (dashed) em coordenadas do mundo dash3d <- function(p0, p1, col = "gray40", lwd = 2, alpha = 0.6, dash_frac = 0.06, gap_frac = 0.04) { p0 <- as.numeric(p0); p1 <- as.numeric(p1) v <- p1 - p0; L <- sqrt(sum(v^2)); if (L <= 0) return(invisible(integer(0))) bb <- par3d("bbox") s <- mean(c(bb[2]-bb[1], bb[4]-bb[3], bb[6]-bb[5])) dash_len <- dash_frac * s; gap_len <- gap_frac * s step <- dash_len + gap_len n <- max(1L, floor(L / step)) ids <- integer(0) for (i in 0:(n-1)) { a <- (i*step) / L b <- min((i*step + dash_len) / L, 1) A <- p0 + a * v B <- p0 + b * v ids <- c(ids, lines3d(c(A[1], B[1]), c(A[2], B[2]), c(A[3], B[3]), col = col, lwd = lwd, alpha = alpha)) } invisible(ids) } # ---------- Ponto arbitrário com extras úteis ---------- add_point <- function(p, col = "#7b3294", label = TRUE, proj = TRUE, vector = FALSE, r = NULL, cex = 1.2) { p <- as.numeric(p); stopifnot(length(p) == 3) bb <- par3d("bbox") # [xmin,xmax, ymin,ymax, zmin,zmax] xr <- bb[2]-bb[1]; yr <- bb[4]-bb[3]; zr <- bb[6]-bb[5] s <- mean(c(xr, yr, zr)) # escala média da cena if (is.null(r)) r <- 0.01 * s # raio da esfera proporcional à cena ids <- integer(0) # Ponto ids <- c(ids, spheres3d(p[1], p[2], p[3], radius = r, color = col, shininess = 80, specular = "#cccccc")) # Rótulo (ligeiro desvio para não colar ao ponto) if (label) { ofs <- 0.04 * s ids <- c(ids, text3d(p[1] + ofs, p[2] + ofs, p[3] + ofs, sprintf("(%.2f, %.2f, %.2f)", p[1], p[2], p[3]), color = col, cex = cex)) } # Projeções para os eixos/planos de referência (linhas cinza translúcidas) # Projeções para eixos/planos (cinza translúcido e pontilhado) if (proj) { # ... dentro de if (proj) { ... } gcol <- "gray40"; galpha <- 0.6; glwd <- 2 # tamanho típico da cena para escalar o desvio bb <- par3d("bbox") s <- mean(c(bb[2]-bb[1], bb[4]-bb[3], bb[6]-bb[5])) toff <- 0.06 * s # 6% do tamanho médio da cena # linhas pontilhadas (mantém como já tens com dash3d) ids <- c(ids, dash3d(c(0,0,0), c(p[1],0,0), col=gcol, lwd=glwd, alpha=galpha)) ids <- c(ids, dash3d(c(p[1],0,0), c(p[1],p[2],0), col=gcol, lwd=glwd, alpha=galpha)) ids <- c(ids, dash3d(c(p[1],p[2],0), c(p[1],p[2],p[3]), col=gcol, lwd=glwd, alpha=galpha)) # marquinhas ids <- c(ids, spheres3d(p[1], 0, 0, radius = 0.6*r, color = gcol, alpha = galpha)) ids <- c(ids, spheres3d(0, p[2], 0, radius = 0.6*r, color = gcol, alpha = galpha)) ids <- c(ids, spheres3d(0, 0, p[3], radius = 0.6*r, color = gcol, alpha = galpha)) # valores afastados dos eixos (desvio ortogonal ao eixo) ids <- c(ids, text3d(p[1], toff, 0, sprintf("%.2f", p[1]), col=gcol, alpha=galpha, cex=cex*0.9, depth_test="always")) ids <- c(ids, text3d(toff, p[2], 0, sprintf("%.2f", p[2]), col=gcol, alpha=galpha, cex=cex*0.9, depth_test="always")) ids <- c(ids, text3d(toff, 0, p[3], sprintf("%.2f", p[3]), col=gcol, alpha=galpha, cex=cex*0.9, depth_test="always")) } # Vetor OP (se quiseres mesmo a seta) if (vector) { ids <- c(ids, arrow3d(p0 = c(0,0,0), p1 = p, type = "triangle", col = col, lwd = 6)) } invisible(ids) # devolve os IDs dos objetos (podes apagar com rgl.pop(id=ids)) } # --- Setas robustas: cilindro + cone com 3 pontos sempre --- axis_arrow <- function(p0, p1, col, r = 0.04, head_frac = 0.22, sides = 40) { p0 <- as.numeric(p0); p1 <- as.numeric(p1) v <- p1 - p0 L <- sqrt(sum(v^2)); if (L <= 0) return(invisible(NULL)) head_len <- head_frac * L shaft_end <- p1 - v/L * head_len # garantir >= 3 pontos (evita o subscript out of bounds) mid_shaft <- (p0 + shaft_end)/2 shaft_center <- rbind(p0, mid_shaft, shaft_end) shaft <- cylinder3d(center = shaft_center, radius = r, sides = sides, closed = TRUE) mid_head <- (shaft_end + p1)/2 head_center <- rbind(shaft_end, mid_head, p1) head <- cylinder3d(center = head_center, radius = c(2.5*r, 1.25*r, 0), sides = sides, closed = TRUE) shade3d(shaft, color = col) shade3d(head, color = col) } # Vectores unitários axis_arrow(c(0,0,0), c(1,0,0), "red") axis_arrow(c(0,0,0), c(0,1,0), "green") axis_arrow(c(0,0,0), c(0,0,1), "blue") # Etiquetas lab.cex <- 2 text3d(1.1, 0, 0, expression(bold(italic(e))[x]), col="red", cex=lab.cex) text3d(0, 1.1, 0, expression(bold(italic(e))[y]), col="green", cex=lab.cex) text3d(0, 0, 1.1, expression(bold(italic(e))[z]), col="blue", cex=lab.cex) # “0” na origem text3d(-0.12, -0.12, -0.12, "0", col="gray20", cex=1.5) # ponto arbitrário P add_point(c(0.91, 1.50, 1.15), col = "#3b5bdb", label = TRUE, proj = TRUE, vector = TRUE) # ponto arbitrário P add_point(c(1.40, 1.65, 0.99), col = "#3b5bdb", label = TRUE, proj = TRUE, vector = TRUE) # ponto arbitrário P add_point(c(1.89, 1.80, 1.10), col = "#3b5bdb", label = TRUE, proj = TRUE, vector = TRUE) # ponto arbitrário P add_point(c(2.38, 1.95, 1.50), col = "#3b5bdb", label = TRUE, proj = TRUE, vector = TRUE) # ponto arbitrário P add_point(c(2.87, 2.10, 2.13), col = "#3b5bdb", label = TRUE, proj = TRUE, vector = TRUE) # ponto arbitrário P add_point(c(3.36, 2.25, 2.94), col = "#3b5bdb", label = TRUE, proj = TRUE, vector = TRUE) # ponto arbitrário P add_point(c(3.85, 2.40, 3.92), col = "#3b5bdb", label = TRUE, proj = TRUE, vector = TRUE) # ponto arbitrário P add_point(c(4.34, 2.55, 5.08), col = "#3b5bdb", label = TRUE, proj = TRUE, vector = TRUE)