Здравствуйте. пытаюсь написать программу для изменения габаритов деталей из листовых материалов. Собственно изменять габариты, и перестраивать чертёж научился. не могу решить следующую проблему.
создал согнутую 3Д модель стойки косяка дверной рамы из листового тела,согнутую модель срезал под углом 45 град для стыковки стойки с потолком, далее создал чертёж развёртки детали. после создания развёртки обратил внимание, что на чертеже присутствуют линии, которые мне не нужны. Чертёж создаётся для вырезания заготовки на плазменной машине с ЧПУ. Так вот вопрос: как программно удалить эти отрезки и кривые, зная координаты начала и конца этих отрезков и кривых. в делфи я совсем новичок, да и в Компасе тоже. прикладываю чертёж стойки косяка. файл специально сохранён в DXF так как машина не понимает форматы компаса. кусочки, которые нужно удалить находятся в левой части чертежа на вершинах ломаной, соединяющей горизонтальные участки чертежа.
в первом архиве лежит файл чертежа до удаления, а во втором архиве лежит файл чертежа, который нужно получить.
Если координаты отрезка известны, то можно так:
Grupp:=Doc2D.ksNewGroup(1);
Doc2D.ksEndGroup;
Angle:=(X1,Y1,X2,Y2);
Radius:=DistancePntPnt(X1,Y1,X2,Y2)/2;
Xc:=X1+CosD(Angle)*Radius;
Yc:=Y1+SinD(Angle)*Radius;
Doc2D.ksSelectGroup(Grupp,3,Xc+EpsilonR,Yc+EpsilonR,Xc-EpsilonR,Yc-EpsilonR);
Iter:=ksIterator(Kompas.GetIterator);
Iter.ksCreateIterator(ALL_OBJ,Grupp);
VObj:=Iter.ksMoveIterator('F');
while VObj<>0 do
begin
J:=Doc2D.ksGetObjParam(VObj,nil,0);
if J<>1 then
begin
Doc2D.ksExcludeObjGroup(Grupp,VObj);
VObj:=Iter.ksMoveIterator('N');
end
else
begin
pLineSegment:=IUnknown(ksTransferReference(VObj,ksGetCurrentDocument(0))) as ILineSegment;
if pLineSegment<>nil then
begin
if(Abs(pLineSegment.X1-X1)<Epsilon)and(Abs(pLineSegment.Y1-Y1)<Epsilon)and
(Abs(pLineSegment.X2-X2)<Epsilon)and(Abs(pLineSegment.Y2-Y2)<Epsilon)then
begin
pLineSegment.Delete;
VObj:=0;
end
else
begin
Doc2D.ksExcludeObjGroup(Grupp,VObj);
VObj:=Iter.ksMoveIterator('N');
end;
end;
end;
end;
Iter.ksDeleteIterator;
Doc2D.ksClearGroup(Grupp,True);
Doc2D.ksDeleteObj(Grupp);
Спасибо за скорый ответ, пошёл пробовать ...
Цитата: Sabahs от 16.11.15, 13:40:16
Если координаты отрезка известны, то можно так:
Grupp:=Doc2D.ksNewGroup(1);
Doc2D.ksEndGroup;
Angle:=(X1,Y1,X2,Y2);
Radius:=DistancePntPnt(X1,Y1,X2,Y2)/2;
Xc:=X1+CosD(Angle)*Radius;
Yc:=Y1+SinD(Angle)*Radius;
Doc2D.ksSelectGroup(Grupp,3,Xc+EpsilonR,Yc+EpsilonR,Xc-EpsilonR,Yc-EpsilonR);
Iter:=ksIterator(Kompas.GetIterator);
Iter.ksCreateIterator(ALL_OBJ,Grupp);
VObj:=Iter.ksMoveIterator('F');
while VObj<>0 do
begin
J:=Doc2D.ksGetObjParam(VObj,nil,0);
if J<>1 then
begin
Doc2D.ksExcludeObjGroup(Grupp,VObj);
VObj:=Iter.ksMoveIterator('N');
end
else
begin
pLineSegment:=IUnknown(ksTransferReference(VObj,ksGetCurrentDocument(0))) as ILineSegment;
if pLineSegment<>nil then
begin
if(Abs(pLineSegment.X1-X1)<Epsilon)and(Abs(pLineSegment.Y1-Y1)<Epsilon)and
(Abs(pLineSegment.X2-X2)<Epsilon)and(Abs(pLineSegment.Y2-Y2)<Epsilon)then
begin
pLineSegment.Delete;
VObj:=0;
end
else
begin
Doc2D.ksExcludeObjGroup(Grupp,VObj);
VObj:=Iter.ksMoveIterator('N');
end;
end;
end;
end;
Iter.ksDeleteIterator;
Doc2D.ksClearGroup(Grupp,True);
Doc2D.ksDeleteObj(Grupp);
уважаемый Sabahs, не могли бы подсказать, как описать переменные и какие модули подключить для работы вашего кода, сам разобраться не смог, слишком мало знаний, буду очень благодарен!!!
const
Epsilon = 0.00001;
EpsilonR = 0.00001; // Радиус ловушки
Var
Grupp,VObj:Reference;
Doc2D:ksDocument2D;
Angle,X1,Y1,X2,Y2,Radius,Xc,Yc:Double;
Kompas:KompasObject;
Iter:ksIterator;
J:Integer;
pLineSegment:ILineSegment;
Модули:ksTlb, Libtool, ksApi7, LDefin2D, LtDefine.
В этой части нужно написать так:
Var
Ang:Double;
...
Ang:=Angle(X1,Y1,X2,Y2);
Radius:=DistancePntPnt(X1,Y1,X2,Y2)/2;
Xc:=X1+CosD(Ang)*Radius;
Yc:=Y1+SinD(Ang)*Radius;
PS. Сразу не заметил, что в коде ошибка.
с этой ошибкой я разобрался при компиляции при помощи SDK и интернет :) у меня возникла другая проблема именно на этот код и ещё на строку pLineSegment:=IUnknown(ksTransferReference(VObj,ksGetCurrentDocument(0))) as ILineSegment;
при запуске программы сразу выскакивает ошибка : точка входа в процедуру __libm_sse2_cbrt не найдена в библиотеке DLL libmmd.dll. как побороть эту пакость?
У меня таких ошибок не возникает, Вы код покажите в каком виде, он у Вас.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms,
Dialogs, ksTlb, Libtool, ksApi7, LDefin2D, LtDefine, StdCtrls, ComObj,OleCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
const
Epsilon = 0.00001;
EpsilonR = 0.00001; // радиус ловушки
Var
Grupp,VObj:Reference;
Doc2D:ksDocument2D;
Angle1,X1,Y1,X2,Y2,Radius,Xc,Yc:Double;
Kompas:KompasObject;
Iter:ksIterator;
J:Integer;
pLineSegment:ILineSegment;
begin
x1:=0; y1:=0; x2:=52.157044; y2:=42;
kompas:=KompasObject(GetActiveOleObject('Kompas.Application.5'));
Doc2D:=ksDocument2D(kompas.Document2D());
Grupp:=Doc2D.ksNewGroup(1);
Doc2D.ksEndGroup;
//Angle1:=Angle(X1,Y1,X2,Y2);
//Radius:=DistancePntPnt(X1,Y1,X2,Y2)/2;
//Xc:=X1+CosD(Angle1)*Radius;
//Yc:=Y1+SinD(Angle1)*Radius;
Doc2D.ksSelectGroup(Grupp,3,Xc+EpsilonR,Yc+EpsilonR,Xc-EpsilonR,Yc-EpsilonR);
Iter:=ksIterator(Kompas.GetIterator);
Iter.ksCreateIterator(ALL_OBJ,Grupp);
VObj:=Iter.ksMoveIterator('F');
while VObj<>0 do
begin
J:=Doc2D.ksGetObjParam(VObj,nil,0);
if J<>1 then
begin
Doc2D.ksExcludeObjGroup(Grupp,VObj);
VObj:=Iter.ksMoveIterator('N');
end
else
begin
//pLineSegment:=IUnknown(ksTransferReference(VObj,ksGetCurrentDocument(0))) as ILineSegment;
if pLineSegment<>nil then
begin
if(Abs(pLineSegment.X1-X1)<Epsilon)and(Abs(pLineSegment.Y1-Y1)<Epsilon)and
(Abs(pLineSegment.X2-X2)<Epsilon)and(Abs(pLineSegment.Y2-Y2)<Epsilon)then
begin
pLineSegment.Delete;
VObj:=0;
end
else
begin
Doc2D.ksExcludeObjGroup(Grupp,VObj);
VObj:=Iter.ksMoveIterator('N');
end;
end;
end;
end;
Iter.ksDeleteIterator;
Doc2D.ksClearGroup(Grupp,True);
Doc2D.ksDeleteObj(Grupp);
end;
end.
закоментированны строки, на которые выскакивает вышеописанная ошибка
Код я давал для Dll, а не Exe, поэтому и ошибки.
в том то и дело, что мне нужно именно EXE, суть моей программы в том, чтобы работник ввёл в поля размер двери, а программа изменила эти размеры в моделях, открыла ранее созданные чертежи, перестроила их, немного подредактировала и сохранила в DXF. Далее по DXF будут создаваться коды для ЧПУ станка плазменного раскроя. нужно именно стороннее приложение, чтобы глупый работник не смог сделать ничего с моделью и исходным чертежом.
не подскажете как устранить эту ошибку?
Убрать модуль LibTool и заменить реализованные в нём методы их аналогами, реализованными в интерфейсе математических функций ksMathematic2D.
Angle - ksAngle
DistancePntPnt - ksDistancePntPnt
CosD - ksCosD
SinD - ksSinD
pLineSegment:=IUnknown(kompas.TransferReference(VObj,Doc2D.Reference)) as ILineSegment;
ещё раз благодарю за помощь!!! код перевёл по вашей подсказке по лучилось следующее:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms,
Dialogs, ksTlb, ksApi7, LDefin2D, LtDefine, StdCtrls, ComObj,OleCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
const
Epsilon = 0.00001;
EpsilonR = 0.00001; // ðàäèóñ ëîâóøêè
Var
Grupp,VObj:Reference;
Doc2D:ksDocument2D;
Angle1,X1,Y1,X2,Y2,Radius,Xc,Yc:Double;
Kompas:KompasObject;
Iter:ksIterator;
J:Integer;
pLineSegment:ILineSegment;
Mathematic2D: ksMathematic2D;
begin
x1:=0; y1:=0; x2:=52.157044; y2:=42; // координаты точек удаляемого отрезка
kompas:=nil;
kompas:=KompasObject(GetActiveOleObject('Kompas.Application.5'));
Doc2D:=ksDocument2D(kompas.Document2D());
Grupp:=Doc2D.ksNewGroup(1);
Doc2D.ksEndGroup;
Mathematic2D:=ksMathematic2D(kompas.GetMathematic2D());
angle1:=Mathematic2D.ksAngle(X1,Y1,X2,Y2);
radius:=Mathematic2D.ksDistancePntPnt(X1,Y1,X2,Y2)/2;
Xc:=X1+Mathematic2D.ksCosD(angle1)*Radius;
Yc:=Y1+Mathematic2D.ksSinD(angle1)*Radius;
Doc2D.ksSelectGroup(Grupp,3,Xc+EpsilonR,Yc+EpsilonR,Xc-EpsilonR,Yc-EpsilonR);
Iter:=ksIterator(Kompas.GetIterator);
Iter.ksCreateIterator(ALL_OBJ,Grupp);
VObj:=Iter.ksMoveIterator('F');
while VObj<>0 do
begin
J:=Doc2D.ksGetObjParam(VObj,nil,0);
if J<>1 then
begin
Doc2D.ksExcludeObjGroup(Grupp,VObj);
VObj:=Iter.ksMoveIterator('N');
end
else
begin
pLineSegment:=IUnknown(kompas.TransferReference(VObj,Doc2D.Reference)) as ILineSegment;
if pLineSegment<>nil then
begin
if(Abs(pLineSegment.X1-X1)<Epsilon)and(Abs(pLineSegment.Y1-Y1)<Epsilon)and
(Abs(pLineSegment.X2-X2)<Epsilon)and(Abs(pLineSegment.Y2-Y2)<Epsilon)then
begin
pLineSegment.Delete;
VObj:=0;
end
else
begin
Doc2D.ksExcludeObjGroup(Grupp,VObj);
VObj:=Iter.ksMoveIterator('N');
end;
end;
end;
end;
Iter.ksDeleteIterator;
Doc2D.ksClearGroup(Grupp,True);
Doc2D.ksDeleteObj(Grupp);
end;
end.
запускаю код на исполнение, и ничего не происходит.
после оператора присвоения Grupp:=Doc2D.ksNewGroup(1); Grupp=0 ... в SDK написано, что в случае неудачи ksNewGroup возвращает 0. Это значит, что что-то неверно или куда смотреть дальше ?
Это у Вас, что?
Doc2D:=ksDocument2D(kompas.Document2D());
Doc2D - должен быть документом в котором ищите отрезок, на данный момент времени его нет, со всеми вытекающими последствиями.
да это именно он и идентификатор он получает, в момент запуска кода у меня включен компас и в нём загружен простенький чертёжик, из которого я взял координаты точки отрезка ( посмотрел при помощи инструмента координаты точки и именно их присвоил переменным X1 Y1 X2 Y2)
вот тот самый чертёжик
Если он у Вас загружен и активен, то нужно его получать так:
Doc2D:=ksDocument2D(Kompas.ActiveDocument2D);
Kompas в скобках должно быть 1 раз, верно ?
Grupp появился, но теперь VObj равен 0, в следствии чего не выполняется условие для удаления отрезка...
А он там есть?
x1:=0; y1:=0; x2:=52.157044; y2:=42; // координаты точек удаляемого отрезка
Внимательно, смотрим на картинку.
всё верно, уже сам обратил на это внимание и исправил координаты ловушки в строке
Doc2D.ksSelectGroup(Grupp,3,-Xc+EpsilonR,-Yc+EpsilonR,Xc-EpsilonR,Yc-EpsilonR);
но пока не удаляет, смотрю дальше...
Тут менять не надо, единственное, что можно сделать за грубить точность ловушки, т.к. координаты отрезка заданы неточно, а ловушка точная.
загрубить точно ловушки путём увеличения константы EpsilonR ?
смотрю далее : не выполняется условие if(Abs(pLineSegment.X1-X1)<Epsilon)and(Abs(pLineSegment.Y1-Y1)<Epsilon)and
(Abs(pLineSegment.X2-X2)<Epsilon)and(Abs(pLineSegment.Y2-Y2)<Epsilon)then
в этой части (Abs(pLineSegment.X2-X2)<Epsilon...
Abs(pLineSegment.X2-X2)= 104,3140875, что явно больше Epsilon. я так понимаю, что я перемудрил с отрицательными координатами вершин отрезков...
Увеличить EpsilonR и Epsilon, до 0,1 мм.
А вот, что Вы со знаками намудрили, я не знаю, я не телепат.
я дико извиняюсь, сам дурак, при присвоении переменным координат точки забыл для X2 указать отрицательное значение координаты т.к. она по факту имеет отрицательное значение. всё заработало и отрезок удалился. Огромное спасибо Sabahs за помощь!!! осталось этот код подогнать под мои конкретные нужды и всё, но это уже совсем другая история :)
Sabahs, ещё один вопрос, надеюсь последний в моей затее, данный код с кривыми будет работать аналогично прямым?
Будет, только нужно будет правильно объект определять, и использовать не интерфейс отрезка, а непосредственно интерфейс, соответствующий типу объекта.
итоговый код для удаления отрезка в прикреплённом чертеже по координатам
x1:=0; y1:=0; x2:=-52.157044; y2:=42;
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms,
Dialogs, ksTlb, ksApi7, LDefin2D, LtDefine, StdCtrls, ComObj,OleCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
const
Epsilon = 0.00001;
EpsilonR = 0.00001; // радиус Ловушки
Var
Grupp,VObj:Reference;
Doc2D:ksDocument2D;
Angle1,X1,Y1,X2,Y2,Radius,Xc,Yc:Double;
Kompas:KompasObject;
Iter:ksIterator;
J:Integer;
pLineSegment:ILineSegment;
Mathematic2D: ksMathematic2D;
begin
x1:=0; y1:=0; x2:=-52.157044; y2:=42;
kompas:=nil;
kompas:=KompasObject(GetActiveOleObject('Kompas.Application.5'));
Doc2D:=ksDocument2D(kompas.ActiveDocument2D);
Grupp:=Doc2D.ksNewGroup(1);
Doc2D.ksEndGroup;
Mathematic2D:=ksMathematic2D(kompas.GetMathematic2D());
angle1:=Mathematic2D.ksAngle(X1,Y1,X2,Y2);
radius:=Mathematic2D.ksDistancePntPnt(X1,Y1,X2,Y2)/2;
Xc:=X1+Mathematic2D.ksCosD(angle1)*Radius;
Yc:=Y1+Mathematic2D.ksSinD(angle1)*Radius;
Doc2D.ksSelectGroup(Grupp,3,Xc+EpsilonR,Yc+EpsilonR,Xc-EpsilonR,Yc-EpsilonR);
Iter:=ksIterator(Kompas.GetIterator);
Iter.ksCreateIterator(ALL_OBJ,Grupp);
VObj:=Iter.ksMoveIterator('F');
while VObj<>0 do
begin
J:=Doc2D.ksGetObjParam(VObj,nil,0);
if J<>1 then
begin
Doc2D.ksExcludeObjGroup(Grupp,VObj);
VObj:=Iter.ksMoveIterator('N');
end
else
begin
pLineSegment:=IUnknown(kompas.TransferReference(VObj,Doc2D.Reference)) as ILineSegment;
if pLineSegment<>nil then
begin
if(Abs(pLineSegment.X1-X1)<Epsilon)and(Abs(pLineSegment.Y1-Y1)<Epsilon)and
(Abs(pLineSegment.X2-X2)<Epsilon)and(Abs(pLineSegment.Y2-Y2)<Epsilon)then
begin
pLineSegment.Delete;
VObj:=0;
end
else
begin
Doc2D.ksExcludeObjGroup(Grupp,VObj);
VObj:=Iter.ksMoveIterator('N');
end;
end;
end;
end;
Iter.ksDeleteIterator;
Doc2D.ksClearGroup(Grupp,True);
Doc2D.ksDeleteObj(Grupp);
end;
end.
условия: 1 Компас должен быть открыт
2 чертёж должен быть в него загружен
подскажите пожалуйста где почитать о том как правильно определить объект и про их интерфейсы. заранее благодарен
Читать в SDK.
Вы код выше приведённый проанализируйте и ненужно будет вопросов задавать.
J:=Doc2D.ksGetObjParam(VObj,nil,0);
уважаемый Sabahs, если вас не затруднит, научите меня, как удалить кривую NURBS из чертежа. SDK читал, так ничего и не понял...
J:=Doc2D.ksGetObjParam(VObj,nil,0);
J=33 , SDK говорит, что это кривая NURBS. что мне с ней дальше делать, как удалить, ума не приложу...
Не понимаю проблемы, Вы читать, умеете?
проблема в том, что я не понимаю синтаксиса, что к чему прикрутить и от чего взять. Всё-таки SDK рассчитан на опытных пользователей, а я совсем новичок в программировании и язык знаю на уровне школы со словарём... Читал SDK, но для меня это пока санскрит, а в сети, кроме как здесь информации нет практически никакой... Простите, если отвлекаю... Просто Вы единственный адекватный источник информации по SDK компаса получаетесь.
Var
Eprst:INurbs;
...
if J=33 then Eprst:=IUnknown(kompas.TransferReference(VObj,Doc2D.Reference)) as INurbs;
огромное спасибо, вот только похоже чего-то на домашнем компьютере я что-то открутил, т.к. вчера вечером дома этот же оператор вылетал с ошибкой Interface not suported. на работе всё сработало и кривая удалилась.
Ещё раз огромное спасибо за помощь и отзывчивость.