Implement settable properties

How about the old Gayley-Villegas trick?

Obj /: (lhs_ = Obj[id_]) := 
  Block[{$inSet = True},
 lhs /: (lhs["Property"] = value_) := setObjProperty[id, value];
 lhs /: Unset[lhs] := ClearAll[lhs];
 lhs = Obj[id]
  ] /; ! TrueQ[$inSet]

Then we get the following behaviour:

obj = Obj[1];
UpValues[obj]

{HoldPattern[obj["Property"] = value$_] :> setObjProperty[1, value$]}

obj["Property"] = 42;
properties

{42}

It's a bit dirty though, but it might just be what you're after.

Well that's a hairy one. I like it though, as it forced me to think about aspects of evaluation that I am normally oblivious to. Unfortunately that thinking didn't lead to any great insights. My only idea so far is to interrupt evaluation and mess with the Stack as Leonid did for How do you set attributes on SubValues?
I have little experience in this area and I am sure to make a number of blunders before I figure it out, but nevertheless here is a first attempt as a proof of concept.

Starting with your own definitions:

properties = {42};

Obj[id_]["Property"] := properties[[id]]

Obj /: (Obj[id_]["Property"] = value_) := setObjProperty[id, value]

setObjProperty[id_, value_] := properties[[id]] = value

And adding mine:

_Obj :=
  Block[{Obj},
    Obj /: (Obj[id_]["Property"] = value_) := setObjProperty[id, value];
    With[{set = 
      Cases[Stack[_], HoldForm[L_ = R_]?(FreeQ[#, Obj] &) :> ((# = R) &@L), 1, 1]},
      Return[set[[1]], Set] /; set =!= {}
    ]
  ]

This surely adds significant and possibly unacceptable overhead. Nevertheless:

obj = Obj[1];

obj["Property"] = 256;

properties

{256}

I make no claim that this is in any way robust. Perhaps something better will come to me later.