Тема: как определить координаты узлов 2D сетки
Мужики, подскажите как решить задачу:
Нанесена прямоугольная 2D сетка, хотелось бы
чтобы после выделения получить координаты всех узлов...
подбросьте мысль, пожалуйста
Спасибо,
Mike
Информационный портал для профессионалов в области САПР
Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Форумы CADUser → Программирование → LISP → как определить координаты узлов 2D сетки
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Мужики, подскажите как решить задачу:
Нанесена прямоугольная 2D сетка, хотелось бы
чтобы после выделения получить координаты всех узлов...
подбросьте мысль, пожалуйста
Спасибо,
Mike
[rus]A kakim obrazom nanesena to?
Tocki ? bloki? ili najti peresecenija linij?
Tocki, bloki, eto prosto, s linijami poslozneje (dlia menia)[/rus]
Предупреждение! Помещайте транслит между тагами [rus] и [/rus].
/Администратор./
сетка построена линиями нужно искать точки пересечения
Самое сложное - это разделить линии на горизонтальные и вертикальные. А когда они поделены то в двух вложенных циклах выполнить функцию inters, формируя список точек пересечения - это уже не сложно.
Собственно, сложным образом делить линии нет необходимости: создать набор из всех интересующих линий, для первого в наборе отрезка найти все точки пересечения с остальными отрезками из набора (в пределах длины отрезка), затем исключить этот отрезок из набора; повторять, пока в наборе более одного отрезка. Исключение очередного отрезка позволит избежать генерации "дублированных" точек.
Всем большое спасибо, код согласно алгоритму 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) ) ) )
На пути от 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")))))) )
Большое спасибо! Классный код! Признаться честно сразу "въехать" было тяжеловато для меня...
один вопрос, если можно: inters с опцией T и вообще без опции это одно и тоже? или я ошибаюсь?
С (inters) некая "инверсия" - отсутствие действительно означает не-nil, хотя для обыденного сознания более привычно nil; с другой стороны, явное пересечение "ближе к поверхности" и подразумевается в обычной геометрии. В то же время не-nil означает, что необходимость учета длин отрезков поддается вычислению (в данном примере T - кратчайшая форма вычисления, своего рода напоминание о его возможности).
для сравнения код с применением 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)) ) ) )
Не хуже, не лучше - просто, для разнообразия
На основе кода > VH (2004-03-11 16:07:08)
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Форумы CADUser → Программирование → LISP → как определить координаты узлов 2D сетки
Форум работает на PunBB, при поддержке Informer Technologies, Inc