K  =  X[1, 4, 2, 5] X[3, 6, 4, 1] X[5, 2, 6, 3]

SetAttributes[P,  Orderless];
KB0[K_] := 
      Expand[
Expand[
K  /.  
              X[a_, b_, c_, d_] :> 
                A P[a, d] P[b, c] + 
                  1/A P[a, b] P[c, 
                      d]
]  //. {
P[a_, 
                  b_] P[b_, c_] :> 
              P[a, c], 
P[a_, b_]^2  ->  -A^2 - 
                1/A^2}
]

KB0[K]

KB1[pd_PD] := KB1[pd, {}, 1];
KB1[pd_PD, inside_, web_] := 
        Module[
{pos = 
              First[Ordering[Length[Complement[List @@ #, inside]] & /@ 
                    pd]]}, pd[[pos]] /.  
            X[a_, b_, c_, d_] :>  
              KB1[
Delete[pd, pos], 
                Union[inside, {a, b, c, 
                    d}], 
Expand[
web*(A P[a, d] P[b, c] + 1/A P[a, b] P[c, d])]
 //. {P[e_, 
                          f_] P[f_, g_] :> P[e, g], 
                    P[e_, _]^2 :> P[e, e], 
                    P[e_, e_] -> -A^2 - 
                        1/A^2}
]
];
KB1[PD[], _, web_] := Expand[web]