Question

我需要将颜色条放置到包含多条迹线的mesh3d图上。每个mesh3d迹线只有一种颜色，但是我需要颜色条来覆盖所有迹线颜色。

我正在尝试将带有visible="legendonly"的scatter3d与mesh3d结合使用，因此实现此目的。但是在绘制网格时，图例将被删除。

以直升飞机为例：

library(plotly)
library(geomorph)

plyFile <- 'http://people.sc.fsu.edu/~jburkardt/data/ply/chopper.ply'
dest <- basename(plyFile)
if (!file.exists(dest)) {
  download.file(plyFile, dest)
}

mesh <- read.ply(dest, ShowSpecimen = F)
# see getS3method("shade3d", "mesh3d") for details on how to plot

# plot point cloud
x <- mesh$vb["xpts",]
y <- mesh$vb["ypts",]
z <- mesh$vb["zpts",]
m <- matrix(c(x,y,z), ncol=3, dimnames=list(NULL,c("x","y","z")))

# now figure out the colormap
zmean <- apply(t(mesh$it),MARGIN=1,function(row){mean(m[row,3])})

library(scales)
facecolor = colour_ramp(
  brewer_pal(palette="RdBu")(9)
)(rescale(x=zmean))


plot_ly()  %>%
  # Creates the legend, and also the plotting space
  add_trace(
    x = x, y = y, z = z,
    color = x,
    colors = c("#ffffff", "#000000"),
   # visible="legendonly",
    type = "scatter3d",
    mode="markers"
  ) %>% 

  # Adds the mesh, but removes the legend
  add_trace(
    x = x, y = y, z = z,
    i = mesh$it[1,]-1, j = mesh$it[2,]-1, k = mesh$it[3,]-1,
    facecolor = facecolor,
    type = "mesh3d"
  )

Answer 1

经过大量黑客攻击，我终于有了一个可行的解决方案。在这种情况下，通过绘制mesh3d区域，使点位于直升机“内部”，以后将不可见，然后再绘制实际的直升机。

似乎“ visible ='legendonly'”不适用于mesh3d，因为此选项会同时删除绘图和图例。

library(plotly)
library(geomorph)

plyFile <- 'http://people.sc.fsu.edu/~jburkardt/data/ply/chopper.ply'
dest <- basename(plyFile)
if (!file.exists(dest)) {
  download.file(plyFile, dest)
}

mesh <- read.ply(dest, ShowSpecimen = F)
# see getS3method("shade3d", "mesh3d") for details on how to plot

# plot point cloud
x <- mesh$vb["xpts",]
y <- mesh$vb["ypts",]
z <- mesh$vb["zpts",]
m <- matrix(c(x,y,z), ncol=3, dimnames=list(NULL,c("x","y","z")))

# now figure out the colormap
zmean <- apply(t(mesh$it),MARGIN=1,function(row){mean(m[row,3])})

# Get colors you want
cols = brewer_pal(palette="RdBu")(9)

# Ramp to add to facecolor
library(scales)
facecolor = colour_ramp(cols)(rescale(x=zmean))

# Create data.frame of colours and breakpoints.
# Must go from 0 to 1, plotly scales it based on values it self.
colz = data.frame(seq(0,1,length.out = length(cols)), 
              cols)

# Make stupid pointcloud to fool the colorbar
xx = c(min(x), max(x))
yy = c(min(y), max(y))
zz = c(min(z), max(z))

plot_ly()  %>%

  # Creates the legend, and also the plotting space
  add_trace(
    x = xx, y = yy, z = zz,
    intensity = x,
    colorscale = colz,
   # visible="legendonly",
    type = "mesh3d"
  ) %>% 


  # Adds the mesh
  add_trace(
    x = x, y = y, z = z,
    i = mesh$it[1,]-1, j = mesh$it[2,]-1, k = mesh$it[3,]-1,
    facecolor = facecolor,
    showscale=FALSE,
    type = "mesh3d"
  )

在不使用强度的情况下（使用facecolor）将网格颜色条添加到mesh3d

1 个答案: