• Добро пожаловать на Форум пользователей ПО АСКОН. Пожалуйста, авторизуйтесь.
 

Уважаемые пользователи,

Хотим проинформировать вас о режиме работы регистрации на нашем сайте.

Зарегистрироваться возможно в рабочие дни, с 8:00 до 20:00 (мск).

Если у вас возникнут вопросы или потребуется дополнительная информация, не стесняйтесь обращаться к нашей службе поддержки. Вы можете связаться с нами по указанным контактным данным на нашем сайте.

Благодарим вас за понимание и сотрудничество. Мы ценим ваше терпение и стремимся предоставить вам лучший опыт использования нашего сервиса.

С уважением,
Команда Ascon

Удаление отрезков и кривых из готового чертежа, Delphi

Автор HellFox, 16.11.15, 13:05:31

« назад - далее »

0 Пользователи и 1 гость просматривают эту тему.

HellFox

Grupp появился, но теперь VObj равен 0, в следствии чего не выполняется условие для удаления отрезка...

А он там есть?
x1:=0; y1:=0; x2:=52.157044; y2:=42; // координаты точек удаляемого отрезка
Внимательно, смотрим на картинку.

HellFox

всё верно, уже сам обратил на это внимание и исправил координаты ловушки в строке

Doc2D.ksSelectGroup(Grupp,3,-Xc+EpsilonR,-Yc+EpsilonR,Xc-EpsilonR,Yc-EpsilonR);

но пока не удаляет, смотрю дальше...

Тут менять не надо, единственное, что можно сделать за грубить точность ловушки, т.к. координаты отрезка заданы неточно, а ловушка точная.

HellFox

загрубить точно ловушки путём увеличения константы 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 мм.
А вот, что Вы со знаками намудрили, я не знаю, я не телепат.

HellFox

я дико извиняюсь, сам дурак, при присвоении переменным координат точки забыл для X2 указать отрицательное значение координаты т.к. она по факту имеет отрицательное значение. всё заработало и отрезок удалился. Огромное спасибо Sabahs за помощь!!! осталось этот код подогнать под мои конкретные нужды и всё, но это уже совсем другая история :)

HellFox

Sabahs, ещё один вопрос, надеюсь последний в моей затее, данный код с кривыми будет работать аналогично прямым?

Будет, только нужно будет правильно объект определять, и использовать не интерфейс отрезка, а непосредственно интерфейс, соответствующий типу объекта.

HellFox

итоговый код для удаления отрезка в прикреплённом чертеже по координатам
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 чертёж должен быть в него загружен

HellFox

подскажите пожалуйста где почитать о том как правильно определить объект и про их интерфейсы. заранее благодарен

Читать в SDK.
Вы код выше приведённый проанализируйте и ненужно будет вопросов задавать.
J:=Doc2D.ksGetObjParam(VObj,nil,0);

HellFox

уважаемый Sabahs, если вас не затруднит, научите меня, как удалить кривую NURBS из чертежа. SDK читал, так ничего и не понял...
J:=Doc2D.ksGetObjParam(VObj,nil,0);
J=33 , SDK говорит, что это кривая NURBS. что мне с ней дальше делать, как удалить, ума не приложу...

Не понимаю проблемы, Вы читать, умеете?

HellFox

проблема в том, что я не понимаю синтаксиса, что к чему прикрутить и от чего взять. Всё-таки SDK рассчитан на опытных пользователей, а я совсем новичок в программировании и язык знаю на уровне школы со словарём... Читал SDK, но для меня это пока санскрит, а в сети, кроме как здесь информации нет практически никакой... Простите, если отвлекаю... Просто Вы единственный адекватный источник информации по SDK компаса получаетесь.

Var
Eprst:INurbs;
...
if J=33 then Eprst:=IUnknown(kompas.TransferReference(VObj,Doc2D.Reference)) as INurbs;

HellFox

огромное спасибо, вот только похоже чего-то на домашнем компьютере я что-то открутил, т.к. вчера вечером дома этот же оператор вылетал с ошибкой Interface not suported. на работе всё сработало и кривая удалилась.
Ещё раз огромное спасибо за помощь и отзывчивость.