Тема: как определить координаты узлов 2D сетки

Мужики, подскажите как решить задачу:
Нанесена прямоугольная 2D сетка, хотелось бы
чтобы после выделения получить координаты всех узлов...
подбросьте мысль, пожалуйста
Спасибо,
Mike

Re: как определить координаты узлов 2D сетки

[rus]A kakim obrazom nanesena to?
Tocki ? bloki? ili najti peresecenija linij?
Tocki, bloki, eto prosto, s linijami poslozneje (dlia menia)[/rus]
Предупреждение! Помещайте транслит между тагами [rus] и [/rus].
/Администратор./

Re: как определить координаты узлов 2D сетки

сетка построена линиями нужно искать точки пересечения

Re: как определить координаты узлов 2D сетки

Самое сложное - это разделить линии на горизонтальные и вертикальные. А когда они поделены то в двух вложенных циклах выполнить функцию inters, формируя список точек пересечения - это уже не сложно.

Re: как определить координаты узлов 2D сетки

Собственно, сложным образом делить линии нет необходимости: создать набор из всех интересующих линий, для первого в наборе отрезка найти все точки пересечения с остальными отрезками из набора (в пределах длины отрезка), затем исключить этот отрезок из набора; повторять, пока в наборе более одного отрезка. Исключение очередного отрезка позволит избежать генерации "дублированных" точек.

Re: как определить координаты узлов 2D сетки

Всем большое спасибо, код согласно алгоритму VH наверно будет примерно такой, малость корявый но рабочий:

(defun c:grd-pt (/ p point-list intr-list line-sel count ent-name)
  (setq line-sel (ssget '((0 . "Line"))))
  (setq count 0)
  (while (< count (sslength line-sel))
    (setq ent-name (entget (ssname line-sel count)))
    (setq point-list
       (append point-list
           (list (list (cdr (assoc 10 ent-name))
                   (cdr (assoc 11 ent-name))
             )
           )
       )
    )
    (setq count (1+ count))
  )
  (setq remain-list point-list)
  (setq count 0)
  (repeat (- (length point-list) 1)
    (setq remain-list (cdr remain-list))
    (foreach p remain-list
      (if (/= (setq pt-intr (check-inters (nth count point-list) p))
          nil
      )
    (setq intr-list (append intr-list (list pt-intr)))
      )
    )
    (setq count (1+ count))
  )
  (foreach p intr-list
    (point-entmake p "0" 256)
  )
  ;; repeat
)
(defun check-inters (pt-lst1 pt-lst2 /)
  (inters (car pt-lst1)
      (cadr pt-lst1)
      (car pt-lst2)
      (cadr pt-lst2)
  )
)
(defun point-entmake (pt layer colr /)
  (entmake (list
         (cons 0 "POINT")
         (cons 10 pt)
         (cons 8 layer)
         (cons 62 colr)
       )
  )
)

Re: как определить координаты узлов 2D сетки

На пути от BASICа к LISPу:

(defun LINE_LIST (_ss)
 (if (setq e (ssname _ss 0))
  (cons (mapcar '(lambda (_code) (cdr (assoc _code (entget e)))) '(10 11)) (LINE_LIST (ssdel e _ss)))))
(defun PT_LIST (_list)
 (if (setq head (car _list) _list (cdr _list))
  (append
   (apply 'append
    (mapcar
    '(lambda (_element) (if _element (list _element)))
     (mapcar
     '(lambda (_pair) (apply 'inters (append head _pair '(T))))
      _list)))
   (PT_LIST _list))))
(defun C:MESHPOINTS ()
 (mapcar
 '(lambda (_pt) (entmake (mapcar 'cons '(0 10) (list "POINT" _pt))))
  (PT_LIST (LINE_LIST (ssget "X" '((0 . "LINE"))))))
)

Re: как определить координаты узлов 2D сетки

Большое спасибо! Классный код! Признаться честно сразу "въехать" было тяжеловато для меня...
один вопрос, если можно: inters с опцией T и вообще без опции это одно и тоже? или я ошибаюсь?

Re: как определить координаты узлов 2D сетки

С (inters) некая "инверсия" - отсутствие действительно означает не-nil, хотя для обыденного сознания более привычно nil; с другой стороны, явное пересечение "ближе к поверхности" и подразумевается в обычной геометрии. В то же время не-nil означает, что необходимость учета длин отрезков поддается вычислению (в данном примере T - кратчайшая форма вычисления, своего рода напоминание о его возможности).

Re: как определить координаты узлов 2D сетки

для сравнения код с применением VL-

(defun C:MESHPOINTS ()
  (mapcar
    '(lambda (_pt) (entmake (mapcar 'cons '(0 10) (list "POINT" _pt))))
    (mapcar
      'vlax-safearray->list
      (vl-remove-if-not
    (function (lambda (x) (= 2 (vlax-safearray-get-u-bound x 1))))
    (mapcar
      'vlax-variant-value
      (apply
        'append
        (PT_LIST
          (mapcar
        'vlax-ename->vla-object
        (mapcar 'cadr (ssnamex (ssget "X" '((0 . "LINE")))))
          )
        )
      )
    )
      )
    )
  )
  (princ)
)
(defun PT_LIST (_list / first)
  (setq first (car _list))
  (if (> (length _list) 1)
    (cons
      (mapcar
    (function (lambda (x) (vla-intersectwith first x acextendnone)))
    (cdr _list)
      )
      (PT_LIST (cdr _list))
    )
  )
)

Не хуже, не лучше - просто, для разнообразия smile
На основе кода > VH (2004-03-11 16:07:08)