2
$\begingroup$

Can anyone help me create a line with a label shown in the picture below? The line is discontinuous near the middle to accomodate the label. The label is placed on top to avoid the problem when the two points are too close.

enter image description here

This is what I have so far:

lines[{a1_, a2_}, color_, label_] := Block[{d,l},
d = a2 - a1;
l = Norm[d];
  {Thickness[0.01], color, Line[{a1, a2}]}]

Graphics@lines[{{1, 2}, {3, 5}}, Red]

My plan is to make the line segments about 4/10 of the distance between two points from each end as shown in the following image.

enter image description here

$\endgroup$

1 Answer 1

3
$\begingroup$

The main idea is that a label can be placed at a distance d on an circle at angle rotp around the point pt as defined in the function. The label l can itself be rotated at an angle rotl.

Clear[slope, pt1, pt2, slope, labelAt];

slope[pt1_, pt2_] := ArcTan[Divide @@ Reverse@(pt2 - pt1)]*180/π;

labelAt[pt_, rotp_, d_, l_, rotl_] := Module[{},
  { Rotate[Text[l, pt + FromPolarCoordinates[{d, rotp }]], rotl]}
  ]

pt1 = {1, 5};
pt2 = {3, 4};

Graphics[{
  (* Midpoint *)
  Black, AbsolutePointSize[4], Point@Midpoint[{pt1, pt2}]
  
  (* Label Q1 at pt1 with a red circle *)
  , Red, Circle[pt1, 0.1], 
  labelAt[pt1, 90 Degree + slope[pt1, pt2] Degree, 0.15, "Q1", 
   slope[pt1, pt2] Degree]
  
  (* an orange colored Label Q2 at pt2 with a stylized polygon *)
  , FaceForm[Directive[Green, Opacity[0.2]]], EdgeForm[Red], 
  RegularPolygon[pt2, 0.1, 5]
  , Orange, labelAt[pt2, 60 Degree, 0.2, "Q2", slope[pt1, pt2] Degree]
  
  (* black line stretching 4/5 of the way *)
  , Black
  , Line[{
    Subdivide[pt1, pt2, 5][[1]]
    , Subdivide[pt1, pt2, 5][[3]]
    }]
  
  (* thicker blue line leading up to pt2 *)
  , Blue, AbsoluteThickness[2]
  , Line[{
    Subdivide[pt1, pt2, 5][[4]]
    , Subdivide[pt1, pt2, 5][[6]]
    }]
  
  (* label at midpoint, distance of 0.1 normal to line *)
  (* use -90 to move it to the other side *)
  (* change angle and distance to position it anywhere *)
  , Blue, labelAt[Midpoint[{pt1, pt2}]
   , 90 Degree + slope[pt1, pt2] Degree, 0.1
   , Style[
    "slope = " <> ToString@(slope[pt1, pt2] // N) <> "°", Red,
     12]
   , slope[pt1, pt2] Degree]
  }
 , Frame -> True
 , PlotRange -> {{0, 4}, {3, 6}}
 ]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.