[azetown]

Добрый день.
Встал такой вопрос есть некая область координат в котором присутствует электромагнитное поле определенной величины,
в некотором месте оно больше 1 и образует зону ССЗ. есть координаты пограничной формы, как то надо защтриховать .ту область или преоразовать точки в "последовательную" полилинию. пытался сделать это ни чего путнего не получалось.

1.Возможно ли создать такую полилинию?

2.Возможно ли создать область закраски?

То что у меня получилось.

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

Имея координаты точек и будучи уверенным в том, что они все лежат в одной плоскости, можно создать и полилинию, и область штриховки.

[azetown]

пробовал что получилось в приложениях, массив такой mass[x][y]=величина

собственно заполняю точки так - цикл в цикле

Код:

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

For x:=0 to xmax do
     For y:=0 to ymax do if mass[x][y]>0 then ...(заполняю точки)

Как мне правильно это сделать подскажите алгоритм

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

То есть решение надо на Delphi?

[azetown]

Сообщение от Кулик Алексей aka kpblc То есть решение надо на Delphi?

Желательно. но можно и VBA или lisp но с последним у меня туго

[VVA]

На лисп

Код:

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

(defun entmakex-hatch (L a n s)
;; By ElpanovEvgeniy
;; L - list of list point. like ((pt11 pt12 pt13)(pt21 pt22 pt23))
;; A - angle hatch
;; N - name pattern
;; S - scale
;; returne - hatch ename
;;USE
;|
(entmakex-hatch '(((538.794 584.563) (895.629 584.563) (895.629 997.377) (538.794 997.377))
                  ((386.809 345.13) (670.955 345.13) (670.955 855.369) (386.809 855.369))
                 )
                (/ pi 2)
                "ANSI31"
                2.
) ;_  entmakex-hatch
(entmakex-hatch
(list
  (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car (entsel "\nSelect Polyline:")))))
) ;_  list
(/ pi 2)
"SOLID"
2.
)
(entmakex-hatch
(list
  (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car (entsel "\nSelect Polyline:")))))
) ;_  list
(/ pi 2)
"ANSI31"
2.
)
(entmakex-hatch
(list
  (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car (entsel "\nSelect Polyline:")))))
) ;_  list
(/ pi 2)
"ANSI32"
2.
)
|;
(entmakex
  (apply
   'append
   (list
    (list '(0 . "HATCH")
          '(100 . "AcDbEntity")
          '(410 . "Model")
          '(100 . "AcDbHatch")
          '(10 0.0 0.0 0.0)
          '(210 0.0 0.0 1.0)
          (cons 2 n)
          (if (= n "SOLID")
           '(70 . 1)
           '(70 . 0)
          ) ;_  if
          '(71 . 0)
          (cons 91 (length l))
    ) ;_  list
    (apply 'append
           (mapcar '(lambda (a)
                     (apply 'append
                            (list (list '(92 . 7) '(72 . 0) '(73 . 1) (cons 93 (length a)))
                                  (mapcar '(lambda (b) (cons 10 b)) a)
                                  '((97 . 0))
                            ) ;_  list
                     ) ;_  apply
                    ) ;_  lambda
                   l
           ) ;_  mapcar
    ) ;_  apply
    (if (= n "SOLID")
     (list '(75 . 0)
          '(76 . 1)
          '(47 . 1.)
          '(98 . 2)
          '(10 0. 0. 0.0)
          '(10 0. 0. 0.0)
          '(450 . 0)
          '(451 . 0)
          '(460 . 0.0)
          '(461 . 0.0)
          '(452 . 0)
          '(462 . 0.0)
          '(453 . 2)
          '(463 . 0.0)
          '(63 . 256)
          '(463 . 1.0)
          '(63 . 256)
          '(470 . "LINEAR")
    ) ;_  list
    (list '(75 . 0)
          '(76 . 1)
          (cons 52 a)
          (cons 41 s)
          '(77 . 0)
          '(78 . 1)
          (cons 53 a)
          '(43 . 0.)
          '(44 . 0.)
          '(45 . 1.)
          '(46 . 1.)
          '(79 . 0)
          '(47 . 1.)
          '(98 . 2)
          '(10 0. 0. 0.0)
          '(10 0. 0. 0.0)
          '(470 . "LINEAR")
    ) ;_  list
      )
   ) ;_  list
  ) ;_  apply
) ;_  entmakex
)

Пример использования

Код:

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

;;; lst - список полученных координат ((X1 Y1)(X2 Y2) ... (Xn Yn))
(setq lst '((1908.53 261.609) (1246.5 757.848) (1601.59 1034.54) (2107.14 983.411) (2182.37 430.029)))
(entmakex-hatch (list lst) 0 "SOLID" 2.)

;;; lst - список полученных координат ((X1 Y1)(X2 Y2) ... (Xn Yn))
(setq lst '((908.53 261.609) (246.5 757.848) (601.59 1034.54) (1107.14 983.411) (1182.37 430.029)))
(entmakex-hatch (list lst) 0 "ANSI31" 2.)

Из Delphi можно через Sendcommand загрузить функцию и вызвать ее, а можно записать scr файл и выполнить его командой _script

[Олег (jr.)]

Сообщение от azetown Добрый день. Встал такой вопрос есть некая область координат в котором присутствует электромагнитное поле определенной величины, в некотором месте оно больше 1 и образует зону ССЗ. есть координаты пограничной формы, как то надо защтриховать .ту область или преоразовать точки в "последовательную" полилинию. пытался сделать это ни чего путнего не получалось. 1.Возможно ли создать такую полилинию? 2.Возможно ли создать область закраски? То что у меня получилось.

Спробуй

' ! make sure under "Tools|Options|General" you select "Break on Unhandled Errors" selected

Код:

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

Option Explicit !

Public Sub DynHatch()
' draw lwpolyline interactively
Dim pickPt As Variant
Dim dblCoors() As Double
Dim i As Long
Dim oPoly As AcadLWPolyline

i = 0
On Error Resume Next
pickPt = ThisDrawing.Utility.GetPoint(, vbCr & "Pick a first point: ")
If Err = 0 Then
    ReDim dblCoors(1)
    dblCoors(i) = pickPt(0): dblCoors(i + 1) = pickPt(1)
    Do Until Err.Number <> 0
        i = i + 2
        pickPt = ThisDrawing.Utility.GetPoint(pickPt, vbCr & "Pick next point (or press Enter to End Loop): ")
        ReDim Preserve dblCoors(UBound(dblCoors) + 2)
        dblCoors(i) = pickPt(0): dblCoors(i + 1) = pickPt(1)
        If oPoly Is Nothing Then
            Set oPoly = ThisDrawing.ModelSpace.AddLightWeightPolyline(dblCoors)
        Else
            oPoly.Coordinates = dblCoors
        End If
    Loop
    Dim lngResp As Long
    lngResp = MsgBox("Do you want to close polyline?", vbYesNo, "Close Mode")
    If lngResp = 6 Then
    oPoly.Closed = True
    End If
End If
With ThisDrawing

.SetVariable "HPGAPTOL", 10
.SetVariable "HPNAME", "ANSI31"
.SetVariable "OSMODE", 0
.SetVariable "CMDDIA", 0
.SetVariable "CMDECHO", 0

Dim intPt As Variant
Dim pstr As String

intPt = .Utility.GetPoint(, "Pick the inner point of boundary")
pstr = Replace(CStr(intPt(0)), ",", ".") & "," & Replace(CStr(intPt(1)), ",", ".")
.SendCommand "-BOUNDARY" & vbCr & pstr & vbCr & vbCr
Debug.Print Err.Number 'for the delay only
.SendCommand "_-BHATCH" & vbCr & "S" & vbCr & "L" & vbCr & vbCr & vbCr
.SetVariable "CMDDIA", 1
.SetVariable "CMDECHO", 1
.Regen True

End With
End Sub

[azetown]

Сообщение от Олег (jr.) Спробуй ' ! make sure under "Tools|Options|General" you select "Break on Unhandled Errors" selected Код: [Выделить все] Option Explicit ! Public Sub DynHatch() ' draw lwpolyline interactively Dim pickPt As Variant Dim dblCoors() As Double Dim i As Long Dim oPoly As AcadLWPolyline .. .. ..

"
Если не ошибаюсь этот код закрашивает уже готовый контур-полилинию.
У меня в том и загводка чтобы сделать последовательную полилинию

[Олег (jr.)]

Сообщение от azetown " Если не ошибаюсь этот код закрашивает уже готовый контур-полилинию. У меня в том и загводка чтобы сделать последовательную полилинию

Ошибаешься в примере контур создается динамически указанием последовательных точек
и сразу заполняется массив точек, который потом передается как аргумент в метод создания
этого контура
У тебя уже готовый массив если я так понял или эти точки хранятся в каком-то файле?

[azetown]

Сообщение от VVA На лисп [code] (defun entmakex-hatch (L a n s) ;; By ElpanovEvgeniy ;; L - list of list point. like ((pt11 pt12 pt13)(pt21 pt22 pt23)) ;; A - angle hatch ;; N - name pattern ;; S - scale ;; returne - hatch ename ;;USE ;| ... ...

Попробовал результат в файле не совсем то что хотелось бы иметь в итоге ,

напоминает гребенку или зигзаги,
Есть идеи как помочь мне?

to Олег (jr.)
да данные лежат в файле (test_zo.txt.zip)

[Олег (jr.)]

Сообщение от azetown to Олег (jr.) да данные лежат в файле (test_zo.txt.zip)

Поправь если я неправ...

в текстовом файле:
1-й столбец -- X
2-й столбец -- Y
3-й столбец -- Z???

[azetown]

Сообщение от Олег (jr.) Поправь если я неправ... в текстовом файле: 1-й столбец -- X 2-й столбец -- Y 3-й столбец -- Z???

да толко 3-й столбец это уровень ЭМП (электромагнитного поля)если он больше 1 то область надо закрасить

[Олег (jr.)]

Сообщение от azetown да толко 3-й столбец это уровень ЭМП (электромагнитного поля)если он больше 1 то область надо закрасить

Что-то типа того дальше сам

Код:

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

Option Explicit
Const filename As String = "C:\test_ZO.txt" '<-- change data file name here
Public Function ReadTxtFile(fil As String, delim As String)
Dim fd As Long
Dim sline As String
Dim ar As Variant
Dim txtColl As New Collection
fd = FreeFile
Open fil For Input Access Read Shared As fd
Do Until EOF(fd)
Line Input #fd, sline
If sline <> "" Then
ar = Split(sline, delim)
If Val(ar(2)) > 1# Then
txtColl.Add ar
End If
End If
Loop
Close fd
Set ReadTxtFile = txtColl
End Function

Sub Try()
Dim col As New Collection
Dim itm As Variant
Dim pline As AcadLWPolyline
Dim i As Long, j As Long

Set col = ReadTxtFile(filename, " ")
'delete first line from text collection
col.Remove 1
ReDim ar(0 To col.Count * 2 - 1) As Double
For Each itm In col

ar(i) = Val(itm(0))
i = i + 1
ar(i) = Val(itm(1))
i = i + 1

Next

Set pline = ThisDrawing.ModelSpace.AddLightWeightPolyline(ar)
pline.Closed = True
pline.color = acRed
pline.Update
MsgBox "done"
End Sub