[СергейР]

В VBA из чертежа dwg выбираем область AcDbRegion
( Я могу выделить только площадь,имя,чентр тяжести,периметр).Возможно ли выделить данные-из чего состоит область,координаты вершин.В классе AcadPolygonMesh есть свойство Coordinates() As Object ,только выделить не могу,ответ не определено.Может кто сталкивался с этим?Ведь эти данные где то спрятаны?
Пример.Область состоит из дуги и отрезка.В конечном итоге необходимо получить из области эти данные(начало,конец,радиус,координаты центра)
В CADImport Net v6.3 этот вопрос решен,значит данные вытянуть можно.

[Makswell]

Можно использовать метод Explode. Исходный AcDbRegion не удалится, но на выходе получится массив созданных объектов. Далее считываем нужные данные каждого объекта и применяем к каждому метод Delete.

На VBA не знаю, на лиспе это может выглядеть так (накидал по-быстрому, программа только для областей, состоящих из линий и дуг. Если в области будут присутствовать сплайн, окружность или эллипс прога не заработает):

Код:

[Выделить все]

(defun test (/ obj obj_lst obj_name)
  (if (setq obj (car (entsel)))
    (progn
      (setq obj (vlax-ename->vla-object obj))
      (if (= (vla-get-ObjectName obj) "AcDbRegion")
	(progn
	  (setq	obj_lst
		 (vlax-safearray->list (vlax-variant-value (vla-Explode obj)))
	  )
	  (foreach item	obj_lst
	    (setq obj_name (vla-get-ObjectName item))
	    (princ (strcat "ObjectName=" obj_name "\n"))
	    (princ "StartPoint=")
	    (princ (vlax-safearray->list
		     (vlax-variant-value (vla-get-StartPoint item))
		   )
	    )
	    (princ "\nEndPoint=")
	    (princ (vlax-safearray->list
		     (vlax-variant-value (vla-get-EndPoint item))
		   )
	    )
	    (terpri)
	    (if	(= obj_name "AcDbArc")
	      (progn
		(princ "Center=")
		(princ (vlax-safearray->list
			 (vlax-variant-value (vla-get-Center item))
		       )
		)
		(princ "\nRadius=")
		(princ (vla-get-Radius item))
		(princ "\n\n")
	      )
	      (terpri)
	    )
	    (vla-Delete item)
	  )
	)
      )
    )
  )
  (princ)
)

Результат работы с областью, состоящей из 2-х линий и 3-х дуг:

_$ (test) ObjectName=AcDbLine StartPoint=(-101.839 294.356 0.0) EndPoint=(-90.7236 326.294 0.0) ObjectName=AcDbArc StartPoint=(-101.839 294.356 0.0) EndPoint=(-65.3673 291.926 0.0) Center=(-83.4059 296.099 0.0) Radius=18.515 ObjectName=AcDbArc StartPoint=(-53.2101 328.03 0.0) EndPoint=(-90.7236 326.294 0.0) Center=(-71.8532 324.705 0.0) Radius=18.9372 ObjectName=AcDbArc StartPoint=(-65.3673 291.926 0.0) EndPoint=(-25.9504 300.77 0.0) Center=(-46.3235 299.311 0.0) Radius=20.4254 ObjectName=AcDbLine StartPoint=(-53.2101 328.03 0.0) EndPoint=(-25.9504 300.77 0.0)

Короче, методика такая. Далее по аналогии можно развить программу.

[СергейР]

Спасибо за подсказку метода - все получилось.Главное идея.

[Кулик Алексей aka kpblc]

Координаты вершин лиспом получить можно - Эдуард на caduser.ru выкладывал соответсвтующий лисп.

[СергейР]

Я решил проблему при помощи .net 2003.Когда напишу программу полностью,функцию выложу обязптельно,может кому пригодиться

[СергейР]

Вот что в итоге получилось.

Код:

[Выделить все]

Imports AutoCAD

    Public dataitem(20, 8) As String
    Public Sub region()




        On Error Resume Next
        Dim AcadApp As AcadApplication
        Dim ActDoc As AcadDocument
        Dim objGen As Object
        Dim obj1(10) As Object
        ' Проверка открытого окна AutoCAD
        AcadApp = GetObject(, "AutoCAD.Application.17")
        If Err.Number <> 0 Then
            Err.Clear()
            OpenFile()
        End If
        ' Видимость
        AcadApp.Visible = True


        Dim j As Integer
        Dim cou As Integer

        Dim item As Object


        Dim counter As Integer

        Dim ACount As Integer
        Dim objSelection As Object


        AcadApp = GetObject(, "AutoCAD.Application.17")
        ActDoc = AcadApp.ActiveDocument
        ACount = ActDoc.PickfirstSelectionSet.Count
        objSelection = ActDoc.PickfirstSelectionSet


        objSelection = ActDoc.PickfirstSelectionSet


        If ACount = 0 Then MsgBox("выбери объект", , )


        For j = 1 To ACount
            objGen = objSelection.Item(j — 1)
            If ACount = 0 Then MsgBox("выбери область ", , )
        Next


        item = objGen.Explode

        Dim i As Integer


        Dim k As Integer

        
        Dim itemobj As Object


        For i = 0 To 20



            If item(i).ObjectName = "" Then Exit For


            If item(i).ObjectName = "AcDbLine" Then Line(i, item(i))

            If item(i).ObjectName = "AcDbEllipse" Then Ellipse(i, item(i))
            If item(i).ObjectName = "AcDbArc" Then Arc(i, item(i))
        Next i

        For k = 0 To i
            item(k).delete()

        Next k


        '  dataitem(имя,StartPointX ,StartPointY ,EndPointX ,EndPointY , Radius,CenterХ(0),CenterY(1))





    End Sub
    Public Function Arc(ByVal n As Integer, ByVal itemob As Object)
        dataitem(n, 0) = itemob.Objectname
        dataitem(n, 1) = itemob.startPoint(0)
        dataitem(n, 2) = itemob.startPoint(1)
        dataitem(n, 3) = itemob.EndPoint(0)
        dataitem(n, 4) = itemob.EndPoint(1)
        dataitem(n, 5) = itemob.Radius
        dataitem(n, 6) = itemob.Center(0)
        dataitem(n, 7) = itemob.Center(1)



    End Function

    Public Function Line(ByVal n As Integer, ByVal itemob As Object)
        dataitem(n, 0) = itemob.Objectname

        dataitem(n, 1) = itemob.startPoint(0)
        dataitem(n, 2) = itemob.startPoint(1)
        dataitem(n, 3) = itemob.EndPoint(0)
        dataitem(n, 4) = itemob.EndPoint(1)



    End Function

    Public Function Ellipse(ByVal n As Integer, ByVal itemob As Object)
        dataitem(n, 0) = itemob.Objectname

        dataitem(n, 1) = itemob.startPoint(0)
        dataitem(n, 2) = itemob.startPoint(1)
        dataitem(n, 3) = itemob.EndPoint(0)
        dataitem(n, 4) = itemob.EndPoint(1)


        dataitem(n, 6) = itemob.Center(0)
        dataitem(n, 7) = itemob.Center(1)





    End Function


    Private Sub OpenFile()
        Dim dlgOpen As New OpenFileDialog

        If dlgOpen.ShowDialog() = DialogResult.OK Then
            Dim ProcessStart As New ProcessStartInfo(dlgOpen.FileName)
            Process.Start(ProcessStart)
        End If
    End Sub