Свой САПР на базе Компас

[Mihonius]

Помогите разобраться!
Написал вот такую процедуру. Ошибок вроде бы нет, но не выполняется?
procedure CouplLineLine(const ox1, oy1, ug1, ox2, oy2, ug2, rad : double; usl1, usl2 :boolean); overload;
var
i: Integer;
cir : LongInt;
c_par : ksCircleParam;
t : Integer;
buf : string;
begin
  if (iDoc <> nil) and (iMathematic2D <> nil) then
  begin
  iCON := ksCON(iKompas.GetParamStruct( ko_CON ));
            if iCON <> nil then
            begin
             iMathematic2D.ksCouplingLineLine( ox1, oy1, ug1, ox2, oy2, ug2, rad, iCON );
             for i := 0 to 3 do
                 begin
                 cir:=idoc.ksCircle( iCON.GetXc(i), iCON.GetYc(i), rad, 1 );
                c_par := ksCircleParam( ikompas.GetParamStruct(ko_CircleParam) );
                       if ( c_par <> nil ) then
                      begin
                       t := idoc.ksGetObjParam( cir, c_par, ALLPARAM );
                        buf := Format( 't = %d, xc = %4.1f, yc = %4.1f, rad = %4.1f, tl = %d', [t, c_par.xc, c_par.yc, c_par.rad, c_par.style] );
                        ikompas.ksMessage( buf );
                      end;
                             if (usl1)  or (usl2) then
                             begin
                             idoc.ksLightObj(cir,1);
                             idoc.ksDeleteObj(cir);
                             end
                             else
                             begin
                             idoc.ksTrimmCurve(cir, iCON.GetX1(i), iCON.GetY1(i), iCON.GetX2(i), iCON.GetY2(i), iCON.GetX2(i)-10, iCON.GetY2(i), 1);
                             //idoc.ksLineSeg(iCON_vs.GetX1(i), iCON_vs.GetY1(i), D_st_vs/2, -Vil, 1);
                             end;
                 end;
            end;
  end;
end;

Вызываю так:
usl11:= (c_par.xc)<(D_st_vs/2);
    usl12:= (c_par.yc)>(pol_h_oboda+l_osi-b_disk_st/2);
    CouplLineLine(D_st_vs/2, -Vil, 90-Ugol_st_vs, 0, pol_h_oboda+l_osi-b_disk_st/2, 0, R_st_vs, usl11, usl12);
Пробовал содержимое usl11 и usl12 сразу заганять в параметры результат тот же, программа доходит до процедуры и выдает ошибку Access violation at adress 004A7BAD in module ****.exe
если исключить выделенную жирным часть работает!

[Sabahs]

А отладчик для чего?
Вообще в этой процедуре смысла не вижу, нашли точки сопряжения, затем нашли нужные прочитав координаты из структуры iCON и сравнив с условием, далее построили дугу.
У Вас условие вне функции и проверки не все, поэтому не удивительно, что пытаетесь прочитать несуществующую переменную.

[Mihonius]

спотыкается здесь
usl11:= (c_par.xc)<(D_st_vs/2);
usl12:= (c_par.yc)>(pol_h_oboda+l_osi-b_disk_st/2);

CouplLineLine(D_st_vs/2, -Vil, 90-Ugol_st_vs, 0, pol_h_oboda+l_osi-b_disk_st/2, 0, R_st_vs, c_par.xc<D_st_vs/2, c_par.yc>pol_h_oboda+l_osi-b_disk_st/2); при таком вызове тоже вылетает здесь

как по другому задать выражение в if со знаком?
  if (usl1)  or (usl2) then вместо usl1 -  c_par.xc<D_st_vs/2
вместо usl2 - c_par.yc>pol_h_oboda+l_osi-b_disk_st/2)

[Sabahs]

 if((c_par.yc)>(pol_h_oboda+l_osi-b_disk_st/2))or((c_par.xc)<(D_st_vs/2))then ...
Поставьте точку останова внутри функции и посмотрите конкретно, где вылетает.

[Mihonius]

ошибку нашел! спасибо!
но мою задумку не решает (
if ((c_par.xc) < (usl1))  or ((c_par.yc) > (usl2)) then    суть задумки что бы в этом месте была возможность менять знаки по необходимости, а процедура была бы общей для всех случаев     
begin
idoc.ksLightObj(cir,1);
idoc.ksDeleteObj(cir);
end
else
begin
idoc.ksTrimmCurve(cir, iCON.GetX1(i), iCON.GetY1(i), iCON.GetX2(i), iCON.GetY2(i), iCON.GetX2(i)-10, iCON.GetY2(i), 1);
end;

В таком виде все работает но расположение знаков (< или >) подходит только для одного случая для другого нужно по другому
можно и знаки (<) и (>) вносить как параметр?

[Sabahs]

Умножением на переменную равную 1 или -1, получите положительное или отрицательное число.
Придётся Вам все возможные варианты проверять, операцию в виде переменной задать нельзя.

[Mihonius]

Посоветуйте как логичней всего отстроить сопряжения на картинке. Язык Delphi. Я то уже написал так: отстроил центральную окружность, установил сопряжение с окружностями по сторонам, проверкой откинул лишние, внутри цикла обрезал лишнее у окружностей по сторонам, потом ели выудив точки касания центральной окружности с боковыми обрезал центральную. Получилось работает, но код километровый, а мне еще два похожих фрагмента делать. Может есть по логичней методы?

[Sabahs]

Если хотите можете использовать тригонометрические функции, тогда циклы, обрезания будут не нужны, найдёте точки сопряжения и центры, а затем по этим координатам построите три дуги.

[Mihonius]

Хм, спасибо за идею попробую! Есть еще идея искать точки пересечения используя ksintersect и загонять найденные точки в массив, вопрос для прямых это будет одна точка, для окружности и двух прямых уже 8, как выбирать нужные?

[Sabahs]

IntersectCirLin - Получить координаты точек пересечения окружности и прямой.
- число пересечений (от 0 до 2)

... как выбирать нужные?

По известным Вам признакам.

[Mihonius]

Уважаемый Борис Николаевич! Расскажите по какому принципу Вы строили крановое колесо, мне бы очень помогло! Спасибо

[Sabahs]

Не люблю длинных рассказов, особенно "войну и мир", с чем у Вас проблемы конкретно в техническом плане.
Для кранового колеса достаточно учебника Геометрия 6-10 класс, помню учили меня по этому бестселлеру, причем дочитать достаточно до 7-го класса. 
Все размеры пляшут от габаритов в которые вписываются сопряжения, варианты которых быть не может не рассматриваются, фактически всё раскладывается на треугольники и решается.

[Mihonius]

Не особо получается построить середину диска, ось диска построил там три радиуса по 80 мм, теперь нужен верхний и нижний контур диска и тут проблемы, центральный радиус можно вычислить (80+толщина диска/2) а справа и слева, во первых они разные, во вторых желательно было бы сопрягать с радиусами, но радиус сопряжения неизвестен. подскажите?

[Mihonius]

Здравствуйте!
Помогите реализовать следующее: таблица stringgrid в ней 3 столбца "X", "Y", "R", из таблицы читаем координаты X,Y, если R пустое поле рисуем линию с первой точки во вторую, если R есть рисуем дугу с первой точки во вторую радиусом R.
Пробовал так:
procedure DrawKK;
var
i : Integer;
sg1 : TStringGrid;
begin
iDoc    := ksDocument2D( iKompas.ActiveDocument2D );
      for i := 1 to sg1.RowCount - 1 do
      begin
        if (sg1.Cells[0, i] <> '') and (sg1.Cells[2,i]='') then begin
          idoc.ksLineSeg(StrToFloat(sg1.Cells[0,i]),StrToFloat(sg1.Cells[1,i]),StrToFloat(sg1.Cells[0,i+1]),StrToFloat(sg1.Cells[1,i+1]),1);
      end
      else
      begin
      //здесь будет дуга
     end;
end;
не работает

[Sabahs]

Здесь  for i := 1 to sg1.RowCount - 1 do, как минимум должен быть for i := 1 to sg1.RowCount - 2 do, иначе при i=sg1.RowCount - 1 в строке  idoc.ksLineSeg(StrToFloat(sg1.Cells[0,i]),StrToFloat(sg1.Cells[1,i]),StrToFloat(sg1.Cells[0,i+1]),StrToFloat(sg1.Cells[1,i+1]),1); будет вылет, не считая, что StrToFloat возвращает тип Extended, а входные параметры ksLineSeg - Double, http://forum.ascon.ru/index.php/topic,24036.msg171971.html#msg171971

sg1 : TStringGrid; - внутри функции определена, но не создана.

[Mihonius]

Спасибо!
sg1:= TStringGrid.Create(Application); создал

[Sabahs]

Создать нужно вне функции и инициализировать первоначальные значения, а перед выгрузкой Dll не забыть уничтожить.

[Mihonius]

не очень получается во время проверки условия ячейки пустые, что не так?
Уже все перепробовал. Подскажите!?

[Sabahs]

Я кода инициализации значения ячеек не вижу, что я могу сказать, я же не экстрасенс.

[Mihonius]

unit DrawingKK;
interface
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.OleCtrls, KGAXLib_TLB, Vcl.StdCtrls, KsTLB, ksConstTLB, ks2DCOM_TLB;
type
  TForm1 = class(TForm)
    KGAX1: TKGAX;
    SG1: TStringGrid;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
  iKompas              : KompasObject;
  iDoc                 : ksDocument2D;
implementation
{$R *.dfm}
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if iKompas <> nil then
  begin
    KGAX1.CloseAll;
    iKompas.Quit;
    sg1.Destroy;
  end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
sg1.Cells[0,0]:='Коорд. X';
sg1.Cells[1,0]:='Коорд. Y';
sg1.Cells[2,0]:='Радиус R';
sg1.Cells[0,1]:='100';
sg1.Cells[1,1]:='100';
sg1.Cells[0,2]:='300';
sg1.Cells[1,2]:='300';
sg1.Cells[0,3]:='500';
sg1.Cells[1,3]:='500';
end;
procedure DrawKK;
var
  i, j : Integer;
  sg1 : TStringGrid;
begin
iDoc    := ksDocument2D( iKompas.ActiveDocument2D );
      for i := 1 to sg1.RowCount - 2 do
      begin
      iKompas.ksMessage(sg1.Cells[0, i]);
        if sg1.Cells[0, i]<>'' then
        begin
        idoc.ksLineSeg(StrToFloat(sg1.Cells[0,i]),StrToFloat(sg1.Cells[1,i]),StrToFloat(sg1.Cells[0,i+1]),StrToFloat(sg1.Cells[1,i+1]),1);
        end
      else
      iKompas.ksMessage('дуга');
      end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
iKompas := KompasObject(KGAX1.GetKompasObject);
iDoc    := ksDocument2D( iKompas.ActiveDocument2D );
sg1:= TStringGrid.Create(Form1);
if (iDoc <> nil) then
begin
Drawkk;  //вызов рисования
//idoc.ksLineSeg(StrToFloat(sg1.Cells[0,1]),StrToFloat(sg1.Cells[1,1]),StrToFloat(sg1.Cells[0,2]),StrToFloat(sg1.Cells[1,2]),1);
idoc.ksLine(0,0,0);
iDoc.ksZoomPrevNextOrAll(2);
end;
iDoc := nil;
iKompas := nil;
end;
end.