• На форуме с 24 января 2020г.
  • Сообщений: 1
  • Спасибо: 0

Тема: Изменение масштаба и положения выбранного растра

Добрый день. Подскажете в чем загвоздка, хотел изменить выбранный растр но ни чего не выходит?

void mrastr()
{ 

ads_name name; AcGePoint3d pt;
  Acad::ErrorStatus es;
  if (acedEntSel("\nВыберите растр: ", name, asDblArray(pt)) != RTNORM) return;
  AcDbObjectId objId; acdbGetObjectId(objId, name);
  AcDbObjectPointer<AcDbRasterImage> pRaster(objId,AcDb::kForRead);
  if (pRaster.openStatus() != Acad::eOk) return;
 


 AcGePoint3d org(0,0,0);
 AcGePoint3d TempPoint3d( 300, 0, 0);
 AcGeVector3d LowerRightVector = TempPoint3d.asVector();
 AcGePoint3d TempPoint3d2(0,  300, 0);
 AcGeVector3d OnPlaneVector = TempPoint3d2.asVector();


  pRaster->setOrientation(org, LowerRightVector, OnPlaneVector) ;
    pRaster->setDisplayOpt(AcDbRasterImage::kShow, Adesk::kTrue);
      pRaster->setDisplayOpt(AcDbRasterImage::kTransparent, Adesk::kTrue);

  return;

}

Ответ от Александр Ривилис (изменено: Александр Ривилис, 24 января 2020г. 13:01:44)

  • Откуда: Украина / Киев
  • На форуме с 15 апреля 2005г.
  • Сообщений: 8,666
  • Спасибо: 158

Re: Изменение масштаба и положения выбранного растра

chabanve пишет:

Добрый день. Подскажете в чем загвоздка, хотел изменить выбранный растр но ни чего не выходит?

Причина в AcDb::kForRead вместо AcDb::kForWrite
P.S.: Если будут еще вопросы по ObjectARX - приглашаю сюда: https://adn-cis.org/forum/index.php?board=3.0

Ответ от BAP (изменено: BAP, 28 января 2020г. 06:46:14)

  • BAP
  • Восстановленный участник
  • На форуме с 16 января 2008г.
  • Сообщений: 7
  • Спасибо: 0

Re: Изменение масштаба и положения выбранного растра

Мне часто приходится привязывать/перепревязывать растры. Сечас появилась встроенная утилита ВЫРОВНЯТЬ, но с макросом работать быстрее, если есть кнопка.
Не очень грамотно, но зато эффективно:
Sub Rastr()
    'Привязка растра и блока по двум точкам.
    Dim Rst As AcadRasterImage
    Dim pR1 As Variant, pR2 As Variant  'òî÷êè íà ðàñòðå
    Dim pM1 As Variant, pM2 As Variant  'íà Ìîäåëè ÷åðòåæà
    Dim l1 As Double, l2 As Double, ug1 As Double, ug2 As Double
    Dim dX As Double, dY As Double, m1 As Double, dUg As Double
    Dim SelSet As AcadSelectionSet
    Set SelSet = ThisDrawing.ActiveSelectionSet     
    Dim i As Integer
    i = SelSet.Count
    If i <> 1 Then Exit Sub
      If SelSet.Item(0).ObjectName <> "AcDbRasterImage" Then
        MsgBox ("Выбран объект " & SelSet.Item(0).ObjectName & Chr(10) & " Выберите растр для привязки и повторите попытку")
        Exit Sub
    End If
    Set Rst = SelSet.Item(0)
    ' Return a point using a prompt
    pR1 = ThisDrawing.Utility.GetPoint(, "Первая точка на растре: ")
    pM1 = ThisDrawing.Utility.GetPoint(, "Первая точка на чертеже: ")
   
    pR2 = ThisDrawing.Utility.GetPoint(, "Первая точка на растре: ")
    pM2 = ThisDrawing.Utility.GetPoint(, "Вторая точка на чертеже: ")
'Выбрали 4 точки. Вычислим длины и углы

    dX = pR1(0) - pR2(0)   
    dY = pR1(1) - pR2(1)
    l1 = Sqr(dX * dX + dY * dY)
    ug1 = Atn(dY / dX)
    dX = pM1(0) - pM2(0)   
    dY = pM1(1) - pM2(1)
    l2 = Sqr(dX * dX + dY * dY)
    If dX <> 0 Then
        ug2 = Atn(dY / dX)
    Else
        ug2 = 1.5707963267949
    End If
    m1 = l1 / l2
    dUg = ug1 - ug2
    Rst.ScaleFactor = Rst.ScaleFactor / m1
    Rst.Rotation = Rst.Rotation - dUg
    pM2 = Rst.Origin
Dim p(0 To 2) As Double

dX = pM2(0) - pR1(0)   
dY = pM2(1) - pR1(1)
ug1 = Atn(dY / dX)
ug1 = ug1 - dUg
l1 = Sqr(dX * dX + dY * dY)
l1 = l1 / m1        '163.28
dY = l1 * Sin(ug1)
dX = l1 * Cos(ug1)
p(0) = pM1(0) - dX 
p(1) = pM1(1) - dY
Rst.Origin = p
End Sub