如何解决Mathematica：3D线框
| Mathematica是否支持线框图像的隐藏线去除？如果不是这种情况，这里有没有人遇到过这样做的方法？让我们以此开始：Plot3D[Sin[x+y^2],{x,-3,3},{y,-2,2},Boxed -> False]
Plot3D[Sin[x+y^2],Boxed -> False,PlotStyle -> None]
解决方法
在这里，我提出一个解决方案。首先，我将展示如何使用生成线框的函数，然后，将继续详细解释构成该算法的其余函数。
wireFrame
wireFrame[g_] := Module[{figInfo,opt,pts},{figInfo,opt} = G3ToG2Info[g];
pts = getHiddenLines[figInfo];
Graphics[Map[setPoints[#] &,getFrame[figInfo,pts]],opt]
]
fig = ListPlot3D[
{{0,-1,0},{0,1,{-1,1},{1,1}},Mesh -> {10,10},Boxed -> False,Axes -> False,ViewPoint -> {2,-2,ViewVertical -> {0,MeshStyle -> Directive[RGBColor[0,0.5,0.5]],BoundaryStyle -> Directive[RGBColor[1,0.5]]
]
wireFrame
wireFrame[fig]
G3ToG2Info
getHiddenLines
getFrame
setPoints
G3ToG2Info
getPoints[obj_] := Switch[Head[obj],Polygon,obj[[1]],JoinedCurve,obj[[2]][[1]],RGBColor,{Table[obj[[i]],{i,3}]}
];
setPoints[obj_] := Switch[Length@obj,3,Polygon[obj],2,Line[obj],RGBColor[obj[[1]]]
];
G3ToG2Info[g_] := Module[{obj,opt},obj = ImportString[ExportString[g,\"PDF\",Background -> None],\"PDF\"][[1]];
opt = Options[obj];
obj = Flatten[First[obj /. Style[expr_,opts___] :> {opts,expr}],2];
obj = Cases[obj,_Polygon | _JoinedCurve | _RGBColor,Infinity];
obj = Map[getPoints[#] &,obj];
{obj,opt}
]
getPoints
JoinedCurve
Line
setPoints
getPoints
G3ToG2Info
ExportString
ImportString
Graphics3D
Graphics
obj
obj
Polygon
JoinedCurve
RGBColor
getPoints
{figInfo,opt} = G3ToG2Info[g]getHiddenLines
lineInt[L_,M_,EPS_: 10^-6] := Module[
{x21,y21,x43,y43,x13,y13,numL,numM,den},{x21,y21} = L[[2]] - L[[1]];
{x43,y43} = M[[2]] - M[[1]];
{x13,y13} = L[[1]] - M[[1]];
den = y43*x21 - x43*y21;
If[den*den < EPS,Return[-Infinity]];
numL = (x43*y13 - y43*x13)/den;
numM = (x21*y13 - y21*x13)/den;
If[numM < 0 || numM > 1,Return[-Infinity],Return[numL]];
]
lineInt
L
M
L
M
-Infinity
L
M
u
L[[1]] + u (L[[2]]-L[[1]])
u
lineInt
Manipulate[
Grid[{{
Graphics[{
Line[{p1,p2},VertexColors -> {Red,Red}],Line[{p3,p4}]
},PlotRange -> 3,Axes -> True],lineInt[{p1,{p3,p4}]
}}],{{p1,Locator,Appearance -> \"L1\"},{{p2,{2,Appearance -> \"L2\"},{{p3,-1}},Appearance -> \"M1\"},{{p4,2}},Appearance -> \"M2\"}
]
L[[1]]
M
lineInTri[L_,T_] := Module[{res},If[Length@DeleteDuplicates[Flatten[{T,L},1],SquaredEuclideanDistance[#1,#2] < 10^-6 &] == 3,Return[{}]];
res = Sort[Map[lineInt[L,#] &,{{T[[1]],T[[2]]},{T[[2]],T[[3]]},{T[[3]],T[[1]]} }]];
If[res[[3]] == Infinity || res == {-Infinity,-Infinity,-Infinity},Return[{}]];
res = DeleteDuplicates[Cases[res,_Real | _Integer | _Rational],Chop[#1 - #2] == 0 &];
If[Length@res == 1,Return[{}]];
If[(Chop[res[[1]]] == 0 && res[[2]] > 1) || (Chop[res[[2]] - 1] == 0 && res[[1]] < 0),Return[{0,1}]];
If[(Chop[res[[2]]] == 0 && res[[1]] < 0) || (Chop[res[[1]] - 1] == 0 && res[[2]] > 1),Return[{}]];
res = {Max[res[[1]],0],Min[res[[2]],1]};
If[res[[1]] > 1 || res[[1]] < 0 || res[[2]] > 1 || res[[2]] < 0,Return[{}],Return[res]];
]
L
{.5,1}L = {A,B}{u,v}{A+(B-A)u,A+(B-A)v}T
lineInTri
T
L
T
Manipulate[
Grid[{{
Graphics[{
RGBColor[0,.5,.5],Polygon[{p3,p4,p5}],Line[{p1,Red}]
},lineInTri[{p1,p5}]
}}],-2}},0}},{-2,Appearance -> \"T1\"},Appearance -> \"T2\"},{{p5,Appearance -> \"T3\"}
]
lineInTri
[0,1]
union[obj_] := Module[{p,tmp,dummy,newp,EPS = 10^-3},p = Sort[obj];
tmp = p[[1]];
If[tmp[[1]] < EPS,tmp[[1]] = 0];
{dummy,newp} = Reap[
Do[
If[(p[[i,1]] - tmp[[2]]) > EPS && (tmp[[2]] - tmp[[1]]) > EPS,Sow[tmp]; tmp = p[[i]],tmp[[2]] = Max[p[[i,2]],tmp[[2]]]
];,Length@p}
];
If[1 - tmp[[2]] < EPS,tmp[[2]] = 1];
If[(tmp[[2]] - tmp[[1]]) > EPS,Sow[tmp]];
];
If[Length@newp == 0,{},newp[[1]]]
]
EPS
{{0,.5},{.500000000001}}{{.5,.500000000001}}getSections[L_,obj_,start_ ] := Module[{dummy,p,seg},{dummy,p} = Reap[
Do[
If[Length@obj[[i]] == 3,seg = lineInTri[L,obj[[i]]];
If[Length@seg != 0,Sow[seg]];
],start,Length@obj}
]
];
If[Length@p == 0,Return[union[First@p]]];
]
getSections
L
start
obj
lineInTri
getHiddenLines
G3ToG2Info
getSections
getHiddenLines
getHiddenLines[obj_] := Module[{pts},pts = Table[{},{Length@obj}];
Do[
If[Length@obj[[j]] == 2,pts[[j]] = getSections[obj[[j]],obj,j + 1]
];,{j,Length@obj}
];
Return[pts];
]
getFrame
complement
complement[obj_] := Module[{dummy,p},p} = Reap[
If[obj[[1,1]] != 0,Sow[{0,obj[[1,1]]}]];
Do[
Sow[{obj[[i - 1,obj[[i,1]]}],Length@obj}
];
If[obj[[-1,2]] != 1,Sow[{obj[[-1,1}]];
];
If[Length@p == 0,Flatten@ First@p]
]
getFrame
getFrame[obj_,pts_] := Module[{dummy,lines,L,u,d},lines} = Reap[
Do[
L = obj[[i]];
If[Length@L == 2,If[Length@pts[[i]] == 0,Sow[L]; Continue[]];
u = complement[pts[[i]]];
If[Length@u > 0,Do[
d = L[[2]] - L[[1]];
Sow[{L[[1]] + u[[j - 1]] d,L[[1]] + u[[j]] d}],Length@u,2 }]
];
];
If[Length@L == 1,Sow[L]];,Length@obj}]
];
First@lines
]
Reap
Sow
Append
Compile
Do
Plot3D[Sin[x + y^2],{x,-3,3},{y,2},PlotStyle -> {EdgeForm[None],FaceForm[Red,None]},Mesh -> False]版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。
