На попробуй, вот что я писал, вроде работает:
//Функция получения данных об объекте AutoCada
//Входные данные:
// ShowMessage- показывать или нет сообщения об объектах
//
//Возвращает массив характеристик объекта
// 0. - тип объекта
// 1,2,3,4,5,6 - зависят от типа объекта:
// 'AcDbPolyline': 1 - Площадь полилинии Double
// 2 - Количество точек LongInteger
// 3 - Массив координат точек Double
// 4 - Количество сторон LongInteger
// 5 - Массив сторон IAcadLine
// 6 - Сумма длин сторон Double
// 'AcDbCircle': 1 - Площадь круга Double
// 2 - Массив координат центра Double
// 3 - Радиус окружности Double
// 'AcDbLine': 1 - Массив координат начальной точки Double
// 2 - Массив координат конечной точки Double
// 3 - Длина линии Double
// 4 - Угол наклона Double
Function GetAcadObject(ShowMessage: Boolean; Delited: Boolean): AVariant;
Var
Points: Array of real;
Sides: Array of IAcadLine;
//ListSide: Array of Variant;//TSide;
TMPSide: IAcadLine;
//OneSide: Tside;
Perimetr: Double;
CountPoints, CountSideReal, CountSide: LongInt;
PointsTwo:Array of real;
A: IAcadObject;
i: Integer;
//Ost: Real;
//TecPoint: Integer;
//LLL: Double;
//ReplFl : TReplaceFlags;
R: AVAriant;
ClosedPL, F_E_R: Boolean;
ClosedPolyline: String;
begin
try
AcadDoc.Utility.GetEntity(AcadTMPObject, SelectPoint, 'Выберите объект');
A:=IDispatch(AcadTMPObject) as IAcadObject;
SetLength(R,1);
R[0]:=A.ObjectName;
if A.ObjectName = 'AcDbPolyline' then
begin
{Form1.StatusBar1.Panels[1].Text:='Полилиния';
Form1.StatusBar1.Panels[2].Text:='Площадь объекта: '; }
{Form1.StatusBar1.Panels[3].Text:=FloatToStr(AcadObjectPolyLine.Area);
//Form1.StatusBar1.Panels[1].Text:=AcadTMPObject.ObjectName;}
ResultAcadObject:= IDispatch(AcadTMPObject) as IAcadLWPolyLine;
//R[1]:=ResultAcadObject;
Points:=ResultAcadObject.Coordinates;
SetLength(R,9);
R[3]:=Points;
CountPoints:=round((High(Points)+1)/2);
R[2]:=CountPoints;
R[1]:=ResultAcadObject.Area;
Sides:=ResultAcadObject.Explode;
//ListSide:=VarArrayCreate([0,High(Sides)],);
Perimetr:=0;
CountSideReal:=High(Sides)+1;
If CountPoints-CountSide>1 then
begin
ResultAcadObject.Closed:=True;
Sides:=ResultAcadObject.Explode;
CountSide:=High(Sides)+1;
end;
If CountPoints = CountSide then
begin
ResultAcadObject.Closed:=False;
Sides:=ResultAcadObject.Explode;
CountSide:=High(Sides)+1;
end;
R[4]:=CountSide;
R[5]:=Sides;
R[8]:=CountSideReal;
For i:=0 to High(Sides) do
begin
If Sides[i]<>nil then
begin
//SetLength(ListSide,i+1);
//ListSide[i].IDFirstPoint:=Pl.ListPoint[i].ID;
//ListSide[i].IDSecondPoint:=Pl.ListPoint[i].ID;
//LLL:=Sides[i].Length;
TMPSide:=Sides[i] as IAcadLine;
Perimetr:=Perimetr+TMPSide.Length;
{OneSide.Angle:=TMPSide.Angle;
OneSide.AngleStr:= AcadDoc.Utility.AngleToString(OneSide.Angle, 1, 4);
ReplFl:=[rfReplaceAll];
OneSide.AngleStr:=StringReplace(OneSide.AngleStr,'d','°',ReplFl);
ListSide[i]:=OneSide;}
If Delited then
begin
TMPSide.Erase;
SIdes[i].Erase;
end;
end;
end;
R[6]:=Perimetr;
If ((Points[0]=Points[CountPoints*2-2]) and (Points[1]=Points[CountPoints*2-1]))
then
F_E_R:=True
else
F_E_R:=False;
If ResultAcadObject.Closed
then
ClosedPl:=True
else
ClosedPl:=False;
If F_E_R or ClosedPl then ClosedPolyline:='Замкнутая'
else ClosedPolyline:='Не замкнутая';
R[7]:=ClosedPolyline;
If ShowMessage then
MessageDLG('ВЫБРАНА ПОЛИЛИНИЯ:'+#10#13+#10#13+
'Площадь = '+FloatToStr(R[1])+#10#13+
'Количество точек = '+FloatToStr(R[2])+#10#13+
'Количество сторон = '+FloatToStr(R[8])+#10#13+
'Длина полилинии = '+FloatToStr(R[6])+#10#13+
'Линия - '+ClosedPolyline
, mtConfirmation, [mbCancel], 0);
end;
if A.ObjectName = 'AcDbCircle' then
begin
ResultAcadObject:= IDispatch(AcadTMPObject) as IAcadCircle;
SetLength(R,4);
R[1]:=ResultAcadObject.Area;
Points:=ResultAcadObject.Center;
R[2]:=Points;
R[3]:=ResultAcadObject.Radius;
{Form1.StatusBar1.Panels[1].Text:='Окружность';
Form1.StatusBar1.Panels[2].Text:='Площадь объекта: ';
Form1.StatusBar1.Panels[3].Text:=FloatToStr(AcadObjectCircle.Area);}
If ShowMessage then
MessageDLG('ВЫБРАНА ОКРУЖНОСТЬ:'+#10#13+#10#13+
'Площадь = '+FloatToStr(R[1])+#10#13+
'Радиус = '+FloatToStr(R[3])+#10#13+
'Центр:'+#10#13+
' X = '+FloatToStr(R[2][0])+#10#13+
' Y = '+FloatToStr(R[2][1]), mtConfirmation, [mbCancel], 0);
end;
if A.ObjectName = 'AcDbLine' then
begin
ResultAcadObject:=IDispatch(AcadTMPObject) as IAcadLine;
// AcadObjectLine:=(AcadTMPObject as IAcadLine);
Points:=ResultAcadObject.StartPoint;
PointsTwo:=ResultAcadObject.EndPoint;
SetLength(R,5);
R[1]:=Points;
R[2]:=PointsTwo;
R[3]:=ResultAcadObject.Length;
R[4]:=ResultAcadObject.Angle;
{Form1.StatusBar1.Panels[1].Text:='Линия (отрезок)';
Form1.StatusBar1.Panels[2].Text:='Длина объекта: ';
Form1.StatusBar1.Panels[3].Text:=FloatToStr(AcadObjectCircle.Area);}
If ShowMessage then
MessageDLG('ВЫБРАНА ЛИНИЯ:'+#10#13+#10#13+
'Длина = '+FloatToStr(ResultAcadObject.Length)+#10#13+
'Угол наклона = '+AngleDigitsToAngleGradus(ResultAcadObject.Angle, 1, 4)+#10#13+#10#13+
'Начальная точка:'+#10#13+
' X = '+FloatToStr(Points[0])+#10#13+
' Y = '+FloatToStr(Points[1])+#10#13+#10#13+
'Конечная точка:'+#10#13+
' X = '+FloatToStr(PointsTWO[0])+#10#13+
' Y = '+FloatToStr(PointsTWO[1])+#10#13+#10#13,
mtConfirmation, [mbCancel], 0);
end;
if A.ObjectName = 'AcDbMline' then
begin
ResultAcadObject:= IDispatch(AcadTMPObject) as IAcadMline;
If ShowMessage then
MessageDLG('Выбрана мультилиния'+#10#13,
mtConfirmation, [mbCancel], 0);
end;
if A.ObjectName = 'AcDbArc' then
begin
ResultAcadObject:= IDispatch(AcadTMPObject) as IAcadArc;
If ShowMessage then
MessageDLG('Выбрана дуга'+#10#13,
mtConfirmation, [mbCancel], 0);
end;
if A.ObjectName = 'AcDbHatch' then
begin
ResultAcadObject:= IDispatch(AcadTMPObject) as IAcadHatch;
If ShowMessage then
MessageDLG('Выбрана штриховка (заливка)'+#10#13,
mtConfirmation, [mbCancel], 0);
end;
if A.ObjectName = 'AcDbRegion' then
begin
ResultAcadObject:= IDispatch(AcadTMPObject) as IAcadRegion;
If ShowMessage then
MessageDLG('Выбран замкнутый контур'+#10#13,
mtConfirmation, [mbCancel], 0);
end;
if A.ObjectName = 'AcDbBlockReference' then
begin
ResultAcadObject:= IDispatch(AcadTMPObject) as IAcadBlockReference;
If ShowMessage then
MessageDLG('Выбран блок:'+#10#13+
'Имя - '+ResultAcadObject.Name,
mtConfirmation, [mbCancel], 0);
end;
if A.ObjectName = 'AcDbSpline' then
begin
ResultAcadObject:= IDispatch(AcadTMPObject) as IAcadBlockReference;
If ShowMessage then
MessageDLG('Выбран сплайн'+#10#13,
mtConfirmation, [mbCancel], 0);
end;
if A.ObjectName = 'AcDbEllipse' then
begin
ResultAcadObject:= IDispatch(AcadTMPObject) as IAcadBlockReference;
If ShowMessage then
MessageDLG('Выбран эллипс'+#10#13,
mtConfirmation, [mbCancel], 0);
end;
except
SetLength(R,1);
R[0]:='ОШИБКА ВЫБОРА!!!';
MessageDLG('Объект не выбран!!!', mtError, [mbCancel], 0);
end;
Result:=R;
End;
