Revisions to Sketch-type graphics with transparency and dashed hidden lines?

Added related link to Wolfram Function Repository.

Source Link

edited Feb 21, 2020 at 6:10

27.6k
3
85
165

Update: This function has been updated to compatible with version 12.x and made available on Wolfram Function Repository as ResourceFunction["Graphics3DSketch"]:

https://resources.wolframcloud.com/FunctionRepository/resources/Graphics3DSketch

Update: This function has been updated to compatible with version 12.x and made available on Wolfram Function Repository as ResourceFunction["Graphics3DSketch"]:

https://resources.wolframcloud.com/FunctionRepository/resources/Graphics3DSketch

compatible with Mathematica 10.0

Source Link

edited Jan 4, 2015 at 17:32

Silvia

27.6k
3
85
165

Clear[DashedGraphics3D]
DashedGraphics3D::optx = 
        "Invalid options for Graphics3D are omitted: `1`.";
Off[OptionValue::nodef];
Options[DashedGraphics3D] = {ViewAngle -> 0.4, 
            ViewPoint -> {3, -1, 0.5}, ViewVertical -> {0, 0, 1}, 
            ImageSize -> 800};
DashedGraphics3D[basegraph_, effectFunction_: Identity, 
            opts : OptionsPattern[]] /; ! 
            MatchQ[Flatten[{effectFunction}], {(Rule | RuleDelayed)[__] ..}] :=
    
    Module[{basegraphClean = basegraph /. (Lighting -> _):>Sequence[], exceptopts, fullopts, frontlayer, dashedlayer, borderlayer,
            face3DPrimitives = {Cuboid, Cone, Cylinder, Sphere, Tube, 
                    BSplineSurface}
            },
        
        exceptopts = FilterRules[{opts}, Except[Options[Graphics3D]]];
        If[exceptopts =!= {},
            Message[DashedGraphics3D::optx, exceptopts]
            ];
        fullopts = 
            Join[FilterRules[Options[DashedGraphics3D], Except[#]], #] &@
                FilterRules[{opts}, Options[Graphics3D]];
        
        frontlayer = Show[
                    basegraphbasegraphClean /. Line[pts__] :> {Thick, Line[pts]} /.
                        h_[pts___] /; MemberQ[face3DPrimitives, h]
                                :> {EdgeForm[{Thick}], h[pts]},
                    fullopts,
                    Lighting -> {{"Ambient", White}}
                    ] // Rasterize;
        
        dashedlayer = Show[
                    basegraphbasegraphClean /.
                            {Polygon[__] :> {}, Line[pts__] :> {Dashed, Line[pts]}} /.
                        h_[pts___] /; MemberQ[face3DPrimitives, h]
                                :> {FaceForm[], EdgeForm[{Dashed}], h[pts]},
                    fullopts
                    ] // Rasterize;
        
        borderlayer = Show[basegraphShow[basegraphClean /. RGBColor[__] :> Black,
                            ViewAngle -> (1 - .001) OptionValue[ViewAngle],
                            Lighting -> {{"Ambient", Black}},
                            fullopts,
                            Axes -> False, Boxed -> False
                            ] // Rasterize // GradientFilter[#, 1] & // ImageAdjust;
        
        ImageSubtract[frontlayer, dashedlayer] // effectFunction //
                        ImageAdd[frontlayer // ColorNegate, #] & //
                    ImageAdd[#, borderlayer] & //
                ColorNegate // ImageCrop
        ]

graph1 = Show[{
                SphericalPlot3D[
                    1, {θ, 1/5 1.2 π, π/2}, {ϕ, 0, 1.8 π},
                    PlotStyle -> White,
                    PlotPoints -> 50, Mesh -> None, BoundaryStyle -> Black],
                SphericalPlot3D[
                    1, {θ, 0, π/5}, {ϕ, π/4, 2.1 π},
                    PlotStyle -> FaceForm[Lighter[Blue, .9], GrayLevel[.9]],
                    PlotPoints -> 50, Mesh -> None, BoundaryStyle -> Black],
                Graphics3D[{FaceForm[Lighter[Pink, .8], GrayLevel[.8]], 
                        Cylinder[{{0, 0, 0}, {0, 0, .8 Cos[π/5]}}, Sin[π/5]]}]
                },
            PlotRange -> 1.2 {{-1, 1}, {-1, 1}, {0, 1}}, 
            AxesOrigin -> {0, 0, 0}, Boxed -> False,
            SphericalRegion -> True];

DashedGraphics3D[graph1]

Clear[DashedGraphics3D]
DashedGraphics3D::optx = 
        "Invalid options for Graphics3D are omitted: `1`.";
Off[OptionValue::nodef];
Options[DashedGraphics3D] = {ViewAngle -> 0.4, 
            ViewPoint -> {3, -1, 0.5}, ViewVertical -> {0, 0, 1}, 
            ImageSize -> 800};
DashedGraphics3D[basegraph_, effectFunction_: Identity, 
            opts : OptionsPattern[]] /; ! 
            MatchQ[Flatten[{effectFunction}], {(Rule | RuleDelayed)[__] ..}] :=
    
    Module[{exceptopts, fullopts, frontlayer, dashedlayer, borderlayer,
            face3DPrimitives = {Cuboid, Cone, Cylinder, Sphere, Tube, 
                    BSplineSurface}
            },
        
        exceptopts = FilterRules[{opts}, Except[Options[Graphics3D]]];
        If[exceptopts =!= {},
            Message[DashedGraphics3D::optx, exceptopts]
            ];
        fullopts = 
            Join[FilterRules[Options[DashedGraphics3D], Except[#]], #] &@
                FilterRules[{opts}, Options[Graphics3D]];
        
        frontlayer = Show[
                    basegraph /. Line[pts__] :> {Thick, Line[pts]} /.
                        h_[pts___] /; MemberQ[face3DPrimitives, h]
                                :> {EdgeForm[{Thick}], h[pts]},
                    fullopts,
                    Lighting -> {{"Ambient", White}}
                    ] // Rasterize;
        
        dashedlayer = Show[
                    basegraph /.
                            {Polygon[__] :> {}, Line[pts__] :> {Dashed, Line[pts]}} /.
                        h_[pts___] /; MemberQ[face3DPrimitives, h]
                                :> {FaceForm[], EdgeForm[{Dashed}], h[pts]},
                    fullopts
                    ] // Rasterize;
        
        borderlayer = Show[basegraph /. RGBColor[__] :> Black,
                            ViewAngle -> (1 - .001) OptionValue[ViewAngle],
                            Lighting -> {{"Ambient", Black}},
                            fullopts,
                            Axes -> False, Boxed -> False
                            ] // Rasterize // GradientFilter[#, 1] & // ImageAdjust;
        
        ImageSubtract[frontlayer, dashedlayer] // effectFunction //
                        ImageAdd[frontlayer // ColorNegate, #] & //
                    ImageAdd[#, borderlayer] & //
                ColorNegate // ImageCrop
        ]

graph1 = Show[{
                SphericalPlot3D[
                    1, {θ, 1/5 1.2 π, π/2}, {ϕ, 0, 1.8 π},
                    PlotPoints -> 50, Mesh -> None, BoundaryStyle -> Black],
                SphericalPlot3D[
                    1, {θ, 0, π/5}, {ϕ, π/4, 2.1 π},
                    PlotStyle -> FaceForm[Lighter[Blue, .9], GrayLevel[.9]],
                    PlotPoints -> 50, Mesh -> None, BoundaryStyle -> Black],
                Graphics3D[{FaceForm[Lighter[Pink, .8], GrayLevel[.8]], 
                        Cylinder[{{0, 0, 0}, {0, 0, .8 Cos[π/5]}}, Sin[π/5]]}]
                },
            PlotRange -> 1.2 {{-1, 1}, {-1, 1}, {0, 1}}, 
            AxesOrigin -> {0, 0, 0}, Boxed -> False,
            SphericalRegion -> True];

DashedGraphics3D[graph1]

Clear[DashedGraphics3D]
DashedGraphics3D::optx = 
        "Invalid options for Graphics3D are omitted: `1`.";
Off[OptionValue::nodef];
Options[DashedGraphics3D] = {ViewAngle -> 0.4, 
            ViewPoint -> {3, -1, 0.5}, ViewVertical -> {0, 0, 1}, 
            ImageSize -> 800};
DashedGraphics3D[basegraph_, effectFunction_: Identity, 
            opts : OptionsPattern[]] /; ! 
            MatchQ[Flatten[{effectFunction}], {(Rule | RuleDelayed)[__] ..}] :=
    
    Module[{basegraphClean = basegraph /. (Lighting -> _):>Sequence[], exceptopts, fullopts, frontlayer, dashedlayer, borderlayer,
            face3DPrimitives = {Cuboid, Cone, Cylinder, Sphere, Tube, 
                    BSplineSurface}
            },
        
        exceptopts = FilterRules[{opts}, Except[Options[Graphics3D]]];
        If[exceptopts =!= {},
            Message[DashedGraphics3D::optx, exceptopts]
            ];
        fullopts = 
            Join[FilterRules[Options[DashedGraphics3D], Except[#]], #] &@
                FilterRules[{opts}, Options[Graphics3D]];
        
        frontlayer = Show[
                    basegraphClean /. Line[pts__] :> {Thick, Line[pts]} /.
                        h_[pts___] /; MemberQ[face3DPrimitives, h]
                                :> {EdgeForm[{Thick}], h[pts]},
                    fullopts,
                    Lighting -> {{"Ambient", White}}
                    ] // Rasterize;
        
        dashedlayer = Show[
                    basegraphClean /.
                            {Polygon[__] :> {}, Line[pts__] :> {Dashed, Line[pts]}} /.
                        h_[pts___] /; MemberQ[face3DPrimitives, h]
                                :> {FaceForm[], EdgeForm[{Dashed}], h[pts]},
                    fullopts
                    ] // Rasterize;
        
        borderlayer = Show[basegraphClean /. RGBColor[__] :> Black,
                            ViewAngle -> (1 - .001) OptionValue[ViewAngle],
                            Lighting -> {{"Ambient", Black}},
                            fullopts,
                            Axes -> False, Boxed -> False
                            ] // Rasterize // GradientFilter[#, 1] & // ImageAdjust;
        
        ImageSubtract[frontlayer, dashedlayer] // effectFunction //
                        ImageAdd[frontlayer // ColorNegate, #] & //
                    ImageAdd[#, borderlayer] & //
                ColorNegate // ImageCrop
        ]

graph1 = Show[{
                SphericalPlot3D[
                    1, {θ, 1/5 1.2 π, π/2}, {ϕ, 0, 1.8 π},
                    PlotStyle -> White,
                    PlotPoints -> 50, Mesh -> None, BoundaryStyle -> Black],
                SphericalPlot3D[
                    1, {θ, 0, π/5}, {ϕ, π/4, 2.1 π},
                    PlotStyle -> FaceForm[Lighter[Blue, .9], GrayLevel[.9]],
                    PlotPoints -> 50, Mesh -> None, BoundaryStyle -> Black],
                Graphics3D[{FaceForm[Lighter[Pink, .8], GrayLevel[.8]], 
                        Cylinder[{{0, 0, 0}, {0, 0, .8 Cos[π/5]}}, Sin[π/5]]}]
                },
            PlotRange -> 1.2 {{-1, 1}, {-1, 1}, {0, 1}}, 
            AxesOrigin -> {0, 0, 0}, Boxed -> False,
            SphericalRegion -> True];

DashedGraphics3D[graph1]

added 291 characters in body

Source Link

edited Apr 6, 2014 at 7:03

Silvia

27.6k
3
85
165

Clear[DashedGraphics3D]
DashedGraphics3D::optx = 
        "Invalid options for Graphics3D are omitted: `1`.";
Off[OptionValue::nodef];
Options[DashedGraphics3D] = {ViewAngle -> 0.4, 
            ViewPoint -> {3, -1, 0.5}, ViewVertical -> {0, 0, 1}, 
            ImageSize -> 800};
DashedGraphics3D[basegraph_, effectFunction_: Identity, 
            opts : OptionsPattern[]] /; ! 
            MatchQ[Flatten[{effectFunction}], {(Rule | RuleDelayed)[__] ..}] :=
    
    Module[{exceptopts, fullopts, frontlayer, dashedlayer, borderlayer,
            face3DPrimitives = {Polygon, Cuboid, Cone, Cylinder, Sphere, Tube, 
                    BSplineSurface}
            },
        
        exceptopts = FilterRules[{opts}, Except[Options[Graphics3D]]];
        If[exceptopts =!= {},
            Message[DashedGraphics3D::optx, exceptopts]
            ];
        fullopts = 
            Join[FilterRules[Options[DashedGraphics3D], Except[#]], #] &@
                FilterRules[{opts}, Options[Graphics3D]];
        
        frontlayer = Show[
                    basegraph /. Line[pts__] :> {Thick, Line[pts]} /.
                        h_[pts___] /; MemberQ[face3DPrimitives, h]
                                :> {EdgeForm[{Thick}], h[pts]},
                    fullopts,
                    Lighting -> {{"Ambient", White}}
                    ] // Rasterize;
        
        dashedlayer = Show[
                    basegraph /.
                            {Polygon[__] :> {}, Line[pts__] :> {Dashed, Line[pts]}} /.
                        h_[pts___] /; MemberQ[face3DPrimitives, h] :> 
 {FaceForm[], 
                               :> {FaceForm[], EdgeForm[{Dashed, Black}], h[pts]},
                    fullopts
                    ] // Rasterize;
        
        borderlayer = Show[basegraph /. RGBColor[__] :> Black,
                            ViewAngle -> (1 - .001) OptionValue[ViewAngle],
                            fullopts,
Lighting -> {{"Ambient", Black}},
                         Lighting -> {{"Ambient", Black}}fullopts,
                            Axes -> False, Boxed -> False
                            ] // Rasterize // GradientFilter[#, 1] & // ImageAdjust;
        
        ImageSubtract[frontlayer, dashedlayer] // effectFunction //
                        ImageAdd[frontlayer // ColorNegate, #] & //
                    ImageAdd[#, borderlayer] & //
                ColorNegate // ImageCrop
        ]

hemisphere

DashedGraphics3D[graph1, Lighting -> "Neutral"]

Neutral lighting hemisphere

Clear[DashedGraphics3D]
DashedGraphics3D::optx = 
        "Invalid options for Graphics3D are omitted: `1`.";
Options[DashedGraphics3D] = {ViewAngle -> 0.4, 
            ViewPoint -> {3, -1, 0.5}, ViewVertical -> {0, 0, 1}, 
            ImageSize -> 800};
DashedGraphics3D[basegraph_, effectFunction_: Identity, 
            opts : OptionsPattern[]] /; ! 
            MatchQ[Flatten[{effectFunction}], {(Rule | RuleDelayed)[__] ..}] :=
    
    Module[{exceptopts, fullopts, frontlayer, dashedlayer, borderlayer,
            face3DPrimitives = {Polygon, Cuboid, Cone, Cylinder, Sphere, Tube, 
                    BSplineSurface}
            },
        
        exceptopts = FilterRules[{opts}, Except[Options[Graphics3D]]];
        If[exceptopts =!= {},
            Message[DashedGraphics3D::optx, exceptopts]
            ];
        fullopts = 
            Join[FilterRules[Options[DashedGraphics3D], Except[#]], #] &@
                FilterRules[{opts}, Options[Graphics3D]];
        
        frontlayer = Show[
                    basegraph /. Line[pts__] :> {Thick, Line[pts]},
                    fullopts,
                    Lighting -> {{"Ambient", White}}
                    ] // Rasterize;
        
        dashedlayer = Show[
                    basegraph /.
                            {Polygon[__] :> {}, Line[pts__] :> {Dashed, Line[pts]}} /.
                        h_[pts___] /; MemberQ[face3DPrimitives, h] :> {FaceForm[], 
                                 EdgeForm[{Dashed, Black}], h[pts]},
                    fullopts
                    ] // Rasterize;
        
        borderlayer = Show[basegraph /. RGBColor[__] :> Black,
                            ViewAngle -> (1 - .001) OptionValue[ViewAngle],
                            fullopts,
                            Lighting -> {{"Ambient", Black}},
                            Axes -> False, Boxed -> False
                            ] // Rasterize // GradientFilter[#, 1] & // ImageAdjust;
        
        ImageSubtract[frontlayer, dashedlayer] // effectFunction //
                        ImageAdd[frontlayer // ColorNegate, #] & //
                    ImageAdd[#, borderlayer] & //
                ColorNegate // ImageCrop
        ]

hemisphere

Clear[DashedGraphics3D]
DashedGraphics3D::optx = 
        "Invalid options for Graphics3D are omitted: `1`.";
Off[OptionValue::nodef];
Options[DashedGraphics3D] = {ViewAngle -> 0.4, 
            ViewPoint -> {3, -1, 0.5}, ViewVertical -> {0, 0, 1}, 
            ImageSize -> 800};
DashedGraphics3D[basegraph_, effectFunction_: Identity, 
            opts : OptionsPattern[]] /; ! 
            MatchQ[Flatten[{effectFunction}], {(Rule | RuleDelayed)[__] ..}] :=
    
    Module[{exceptopts, fullopts, frontlayer, dashedlayer, borderlayer,
            face3DPrimitives = {Cuboid, Cone, Cylinder, Sphere, Tube, 
                    BSplineSurface}
            },
        
        exceptopts = FilterRules[{opts}, Except[Options[Graphics3D]]];
        If[exceptopts =!= {},
            Message[DashedGraphics3D::optx, exceptopts]
            ];
        fullopts = 
            Join[FilterRules[Options[DashedGraphics3D], Except[#]], #] &@
                FilterRules[{opts}, Options[Graphics3D]];
        
        frontlayer = Show[
                    basegraph /. Line[pts__] :> {Thick, Line[pts]} /.
                        h_[pts___] /; MemberQ[face3DPrimitives, h]
                                :> {EdgeForm[{Thick}], h[pts]},
                    fullopts,
                    Lighting -> {{"Ambient", White}}
                    ] // Rasterize;
        
        dashedlayer = Show[
                    basegraph /.
                            {Polygon[__] :> {}, Line[pts__] :> {Dashed, Line[pts]}} /.
                        h_[pts___] /; MemberQ[face3DPrimitives, h] 
                                :> {FaceForm[], EdgeForm[{Dashed}], h[pts]},
                    fullopts
                    ] // Rasterize;
        
        borderlayer = Show[basegraph /. RGBColor[__] :> Black,
                            ViewAngle -> (1 - .001) OptionValue[ViewAngle],
                            Lighting -> {{"Ambient", Black}},
                            fullopts,
                            Axes -> False, Boxed -> False
                            ] // Rasterize // GradientFilter[#, 1] & // ImageAdjust;
        
        ImageSubtract[frontlayer, dashedlayer] // effectFunction //
                        ImageAdd[frontlayer // ColorNegate, #] & //
                    ImageAdd[#, borderlayer] & //
                ColorNegate // ImageCrop
        ]

hemisphere

DashedGraphics3D[graph1, Lighting -> "Neutral"]

Neutral lighting hemisphere

fix some spelling and grammar problems.

Source Link

edited Apr 6, 2014 at 4:52

Silvia

27.6k
3
85
165

Loading

fix some spelling and grammar problems.

Source Link

edit approved Apr 6, 2014 at 4:52

grapeot

103
2

Loading

added 236 characters in body

Source Link

edited Apr 6, 2014 at 1:59

Silvia

27.6k
3
85
165

Loading

Source Link

created Apr 6, 2014 at 1:51

Silvia

27.6k
3
85
165

Loading

Stack Exchange Network

Return to Answer