• masha
  • Восстановленный участник
  • На форуме с 18 мая 2006г.
  • Сообщений: 175
  • Спасибо: 0

Тема: WipeOut: как его создать и как с ним бороться? Какие есть альтернативы?

Здравствуйте, уважаемые!... На вас вся надежда, ибо Help безмолвсвует, в инете ничего внятного не вычитала - может, не там искала... Подскажите, пожалуйста, где можно почитать, чтобы понятно стало. Сама задача - сделать надпись в разрыве линии. Возникшие проблемы:
1) если попытаться объявить переменную, то после слова As в списке подсказок никакого AcDbWipeout не появляется.  Неужели Автокад не знает такого примитива? Вопрос из серии "как вырастить фей-хуа в открытом грунте в средней полосе и что с ним потом делать?" :), однако очень хочется разобраться.
2) если забить на Wipeout и пытаться пользоваться обычным растром, то он почему-то не вставляется в чертёж. В результате следующего фрагмента на экране появляется только рамка, по которой вставленный растр должен быть усечён.

Dim raster_phone As AcadRasterImage, boundary(0 To 9) As Double, minP As Variant, maxP As Variant
Dim image_file As String, ins_pt(0 To 2) As Double
    my_text.GetBoundingBox minP, maxP
    boundary(0) = minP(0): boundary(1) = maxP(1)
    boundary(2) = maxP(0): boundary(3) = maxP(1)
    boundary(4) = maxP(0): boundary(5) = minP(1)
    boundary(6) = minP(0): boundary(7) = minP(1)
    boundary(8) = boundary(0): boundary(9) = boundary(1)
    ins_pt(0) = boundary(0)
    ins_pt(1) = boundary(1)
    ins_pt(2) = 0
    image_file = "WhiteUtransparentPhoneForLabels4.jpg"
    Set raster_phone = ThisDrawing.PaperSpace.AddRaster(image_file, ins_pt, 1, rotate_alfa) '2000 - max length for 25000 scale
    raster_phone.ClippingEnabled = True
    raster_phone.ClipBoundary boundary
    raster_phone.Transparency = False
    raster_phone.Brightness = 50
    raster_phone.Contrast = 50

Спасибо всем.

  • masha
  • Восстановленный участник
  • На форуме с 18 мая 2006г.
  • Сообщений: 175
  • Спасибо: 0

Re: WipeOut: как его создать и как с ним бороться? Какие есть альтернативы?

Ну, не получилось у меня по-культурному добиться нужного... Однако и по-некульткрному тоже не работает:

ThisDrawing.SendCommand "_wipeout" & vbCr & p1.Handle & vbCr & p2.Handle & vbCr & p3.Handle & vbCr & p4.Handle _
                            & vbCr & "Close" & vbCr

р1 и др. - точки AcadPoint. Подскажите, пожалуйста, что надо здесь подправить, чтобы Wipeout создался и отобразился?

  • На форуме с 7 ноября 2005г.
  • Сообщений: 505
  • Спасибо: 0

Re: WipeOut: как его создать и как с ним бороться? Какие есть альтернативы?

Еще один раздел обойденный вниманием разработчиков VBA в автокаде?:)

если забить на Wipeout и пытаться пользоваться обычным растром, то он почему-то не вставляется в чертёж. В результате следующего фрагмента на экране появляется только рамка, по которой вставленный растр должен быть усечён

- Не понятно! Что и чего должно усечь?.. Рамка не может вставиться без рисунка:) она и есть вставленный растр. Да и wipeout - это тот же самый raster.
По второму вопросу (некультурному):
обычная практика при использовании sendcommand посылать непосредственно координаты. Вот рабочий пример на скорую руку:

Sub wpt()
Dim p1 As AcadPoint
Dim p2 As AcadPoint
Dim p3 As AcadPoint
Dim p4 As AcadPoint
Dim location1(0 To 2) As Double
Dim location2(0 To 2) As Double
Dim location3(0 To 2) As Double
Dim location4(0 To 2) As Double
Dim cor1 As Variant
Dim cor2 As Variant
Dim cor3 As Variant
Dim cor4 As Variant
    location1(0) = 1#: location1(1) = 1#: location1(2) = 0#
    location2(0) = 1#: location2(1) = 5#: location2(2) = 0#
    location3(0) = 6#: location3(1) = 5#: location3(2) = 0#
    location4(0) = 6#: location4(1) = 1#: location4(2) = 0#
Set p1 = ThisDrawing.ModelSpace.AddPoint(location1)
Set p2 = ThisDrawing.ModelSpace.AddPoint(location2)
Set p3 = ThisDrawing.ModelSpace.AddPoint(location3)
Set p4 = ThisDrawing.ModelSpace.AddPoint(location4)
cor1 = p1.Coordinates
cor2 = p2.Coordinates
cor3 = p3.Coordinates
cor4 = p4.Coordinates
ThisDrawing.SendCommand "_wipeout" & vbCr & cor1(0) & "," & cor1(1) & vbCr & cor2(0) & "," & cor2(1) & vbCr & cor3(0) & "," & cor3(1) & vbCr & cor4(0) & "," & cor4(1) _
                            & vbCr & "Close" & vbCr
End Sub

wipeout вроде отрисовывается без проблем..

  • На форуме с 24 октября 2006г.
  • Сообщений: 16
  • Спасибо: 0

Re: WipeOut: как его создать и как с ним бороться? Какие есть альтернативы?

Убрал лишнее из кода Сидора.

Public Sub test()
    Dim loc1(0 To 2) As Double
    Dim loc2(0 To 2) As Double
    Dim loc3(0 To 2) As Double
    Dim loc4(0 To 2) As Double
    loc1(0) = 1#: loc1(1) = 1#: loc1(2) = 0#
    loc2(0) = 1#: loc2(1) = 5#: loc2(2) = 0#
    loc3(0) = 6#: loc3(1) = 5#: loc3(2) = 0#
    loc4(0) = 6#: loc4(1) = 1#: loc4(2) = 0#
    ThisDrawing.SendCommand "_wipeout" & vbCr & loc1(0) & "," & loc1(1) & vbCr & loc2(0) & "," & loc2(1) & vbCr & loc3(0) & "," & loc3(1) & vbCr & loc4(0) & "," & loc4(1) _
                                & vbCr & " "
End Sub

потестировано в 2007м