Помогите с лиспом преобразования в vlax-объект

tujn08 · 23.03.2015, 15:37

тип данных после излечения из набора LIST. Как сделать, что бы был ENAME?

Код:

 (vl-load-com)
(progn
(setq a (ssget "_X" (list (cons 0 "LWPOLYLINE") (cons 8 "pro")))); создали набор
(setq i -1 b (sslength a));счетчик
(setq i (1+ i))
(setq pl (entmake (entget (ssname a i)))); следующий примитив из набора
		(setq d_pl (vlax-curve-getDistAtParam (vlax-ename->vla-object pl) (vlax-curve-getEndParam pl)));перевели в ВЛА объект и получили длину 
		(setq p2 (rtos d_pl)); длина сидит тут в виде текста
		(setq ccord_begin0 (vlax-curve-getPointAtParam pl (vlax-curve-getStartParam pl)));начальная точка примитива
		(setq ccord_finish0 (vlax-curve-getPointAtParam pl (vlax-curve-getEndParam pl)));конечноая точка примитива
		;переводим точки в текст, объединяем списки
		;(setq ccord_begin (strcat (rtos (setq x1 (nth 0 ccord_begin0))) " "
		;						  (rtos (setq y1 (nth 1 ccord_begin0)))))
		(setq x1 (nth 0 ccord_begin0))
		(setq y1 (nth 1 ccord_begin0))
		;переводим точки в текст, объединяем списки
		;(setq ccord_finish (strcat (rtos (setq x2 (nth 0 ccord_finish0))) " "
		;						   (rtos (setq y2 (nth 1 ccord_finish0)))))
		(setq x2 (nth 0 ccord_finish0))
		(setq y2 (nth 1 ccord_finish0))
		
	(princ "\n X1:" x1)
	(princ "\n Y1:" y1)
	(princ "\n X2:" x2)
	(princ "\n Y2:" y2)
	(princ "\n длина:" p2)
);конец

Сергей812 · 26.03.2015, 11:30

Цитата:

Сообщение от Кулик Алексей aka kpblc

По-моему, vla-intersectwith глубоко параллельно на видимость объектов

Насколько помню, когда пробовал использовать аналогичную функцию в ActiveX/Interop для автонумерации блоков "на ходу" при рисовании полилинии через нее - то при уходе предыдущего узла полилинии за пределы экрана пересечение получить не удавалось.

И видел программу лисповскую (скомпилированную в fas) - которая автоматически нумеровала блоки по полилинии.. так она заметно дергала экран по зуму на всю полилинию, инициализировала атрибуты блоков и потом возвращалась обратно.

gomer · 26.03.2015, 12:08

Цитата:

Сообщение от Сергей812

И видел программу лисповскую (скомпилированную в fas) - которая автоматически нумеровала блоки по полилинии.. так она заметно дергала экран по зуму на всю полилинию, инициализировала атрибуты блоков и потом возвращалась обратно.

возможно там проблема была не с vla-intersectwith а с ssget

Кулик Алексей aka kpblc · 26.03.2015, 12:44

Вот этому коду глубоко параллельно, на экране примитивы или нет...

Код:

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

 (vl-load-com)

(defun zxc (/ fun_intersect _kpblc-conv-selset-to-ename _kpblc-conv-vla-to-list ss_pline ss_insert adoc obj res)

  (defun fun_intersect (pline insert line / _res)
    (or ((lambda ()
           (vla-put-startpoint line (vlax-3d-point (cdr (assoc "min" insert))))
           (vla-put-endpoint
             line
             (vlax-3d-point
               (list (cadr (assoc "min" insert))
                     (caddr (assoc "max" insert))
                     (cadddr (assoc "min" insert))
                     ) ;_ end of list
               ) ;_ end of vlax-3d-point
             ) ;_ end of vla-put-EndPoint
           (_kpblc-conv-vla-to-list (vla-intersectwith pline line acextendnone))
           ) ;_ end of lambda
         )
        ((lambda ()
           (vla-put-startpoint
             line
             (vlax-3d-point
               (list (cadr (assoc "min" insert))
                     (caddr (assoc "max" insert))
                     (cadddr (assoc "min" insert))
                     ) ;_ end of list
               ) ;_ end of vlax-3d-point
             ) ;_ end of vla-put-StartPoint
           (vla-put-endpoint line (vlax-3d-point (cdr (assoc "max" insert))))
           (_kpblc-conv-vla-to-list (vla-intersectwith pline line acextendnone))
           ) ;_ end of lambda
         )
        ((lambda ()
           (vla-put-startpoint
             line
             (vlax-3d-point
               (list (cadr (assoc "max" insert))
                     (caddr (assoc "min" insert))
                     (cadddr (assoc "min" insert))
                     ) ;_ end of list
               ) ;_ end of vlax-3d-point
             ) ;_ end of vla-put-StartPoint
           (vla-put-endpoint line (vlax-3d-point (cdr (assoc "max" insert))))
           (_kpblc-conv-vla-to-list (vla-intersectwith pline line acextendnone))
           ) ;_ end of lambda
         )
        ((lambda ()
           (vla-put-startpoint line (vlax-3d-point (cdr (assoc "min" insert))))
           (vla-put-endpoint
             line
             (vlax-3d-point
               (list (cadr (assoc "max" insert))
                     (caddr (assoc "min" insert))
                     (cadddr (assoc "min" insert))
                     ) ;_ end of list
               ) ;_ end of vlax-3d-point
             ) ;_ end of vla-put-endpoint
           (_kpblc-conv-vla-to-list (vla-intersectwith pline line acextendnone))
           ) ;_ end of lambda
         )
        ) ;_ end of or
    ) ;_ end of defun


  (defun _kpblc-conv-vla-to-list (value / res)
    (cond
      ((listp value)
       (mapcar (function _kpblc-conv-vla-to-list) value)
       )
      ((= (type value) 'variant)
       (_kpblc-conv-vla-to-list (vlax-variant-value value))
       )
      ((= (type value) 'safearray)
       (if (>= (vlax-safearray-get-u-bound value 1) 0)
         (_kpblc-conv-vla-to-list (vlax-safearray->list value))
         ) ;_ end of if
       )
      ((and (= (type value) 'vla-object)
            (vlax-property-available-p value 'count)
            ) ;_ end of and
       (vlax-for sub value
         (setq res (cons sub res))
         ) ;_ end of vlax-for
       )
      (t value)
      ) ;_ end of cond
    ) ;_ end of defun

  (defun _kpblc-conv-selset-to-ename (selset / tab item)
    (cond
      ((not selset) nil)
      ((= (type selset) 'pickset)
       (repeat (setq tab  nil
                     item (sslength selset)
                     ) ;_ end setq
         (setq tab (cons (ssname selset (setq item (1- item))) tab))
         ) ;_ end repeat
       )
      ((= (type selset) 'vla-object)
       (_kpblc-conv-vla-to-list selset)
       )
      ) ;_ end of cond
    ) ;_ end of defun

  (if (and (setq ss_pline (mapcar
                            (function vlax-ename->vla-object)
                            (_kpblc-conv-selset-to-ename (ssget "_X" '((0 . "LWPOLYLINE") (8 . "pro") (67 . 0))))
                            ) ;_ end of mapcar
                 ) ;_ end of setq
           (setq ss_insert (mapcar (function (lambda (x / minp maxp)
                                               (vla-getboundingbox (setq x (vlax-ename->vla-object x)) 'minp 'maxp)
                                               (setq minp (vlax-safearray->list minp)
                                                     maxp (vlax-safearray->list maxp)
                                                     ) ;_ end of setq
                                               (list (cons "obj" x)
                                                     (cons "min" minp)
                                                     (cons "max" maxp)
                                                     ) ;_ end of list
                                               ) ;_ end of lambda
                                             ) ;_ end of function
                                   (_kpblc-conv-selset-to-ename (ssget "_X" '((0 . "INSERT") (8 . "AK_PR") (67 . 0))))
                                   ) ;_ end of mapcar
                 ) ;_ end of setq
           ) ;_ end of and
    (progn
      (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
      (setq obj (vla-addline
                  (vla-get-modelspace adoc)
                  (vlax-3d-point '(0. 0. 0.))
                  (vlax-3d-point '(0. 10. 0.))
                  ) ;_ end of vla-AddLine
            ) ;_ end of setq
      (setq res (mapcar
                  (function
                    (lambda (pline_obj)
                      (list (cons "pline" pline_obj)
                            (cons "insert"
                                  (mapcar (function (lambda (x) (cdr (assoc "obj" x))))
                                          (vl-remove-if-not
                                            (function
                                              (lambda (ins_obj)
                                                (fun_intersect pline_obj ins_obj obj)
                                                ) ;_ end of lambda
                                              ) ;_ end of function
                                            ss_insert
                                            ) ;_ end of vl-remove-if-not
                                          ) ;_ end of mapcar
                                  ) ;_ end of cons
                            ) ;_ end of list
                      ) ;_ end of lambda
                    ) ;_ end of function
                  ss_pline
                  ) ;_ end of mapcar
            ) ;_ end of setq
      (vla-erase obj)
      (vla-endundomark adoc)
      ) ;_ end of progn
    ) ;_ end of if
  res
  ) ;_ end of defun

(defun c:test (/ color)
  ;; Проверка работы функции zxc
  (setq color 1)
  (foreach item (zxc)
    (vla-put-color (cdr (assoc "pline" item)) color)
    (setq color (1+ color))
    (foreach obj (cdr (assoc "insert" item))
      (vla-put-color obj color)
      ) ;_ end of foreach
    (setq color (1+ color))
    ) ;_ end of foreach
  ) ;_ end of defun

tujn08 · 26.03.2015, 13:27

буду изучать, но..

Код:

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

  (
 (("pline" . #<VLA-OBJECT IAcadLWPolyline 000000003aa787c8>) ("insert" #<VLA-OBJECT IAcadBlockReference 000000002b2551b8>)) 
 (("pline" . #<VLA-OBJECT IAcadLWPolyline 000000003aa78888>) ("insert"))
 (("pline" . #<VLA-OBJECT IAcadLWPolyline 000000003aa78948>) ("insert" #<VLA-OBJECT IAcadBlockReference 000000003a919ca8>)) 
 (("pline" . #<VLA-OBJECT IAcadLWPolyline 000000003aa78a08>) ("insert" #<VLA-OBJECT IAcadBlockReference 000000002b255538>)) 
 (("pline" . #<VLA-OBJECT IAcadLWPolyline 000000003aa78ac8>) ("insert"))
 (("pline" . #<VLA-OBJECT IAcadLWPolyline 000000003aa78f48>) ("insert")) 
 (("pline" . #<VLA-OBJECT IAcadLWPolyline 000000003aa78dc8>) ("insert")) 
 (("pline" . #<VLA-OBJECT IAcadLWPolyline 000000003aa790c8>) ("insert" #<VLA-OBJECT IAcadBlockReference 000000003a919bc8>)) 
 (("pline" . #<VLA-OBJECT IAcadLWPolyline 000000003aa78d08>) ("insert")) 
 (("pline" . #<VLA-OBJECT IAcadLWPolyline 000000003aa79248>) ("insert" #<VLA-OBJECT IAcadBlockReference 000000003a919ca8> #<VLA-OBJECT IAcadBlockReference 000000003a919d88>))
 )

я так понял 5 линий остались свободными. Ааа пардон ))) цель то другая. Я уже решил, что полностью мою задачу решили, а тут только нахождение линий и блоков которые пересекаются. Я с VLA объектами еще не дружу

Спасибо!

----- добавлено через ~2 ч. -----

Цитата:

Сообщение от Кулик Алексей aka kpblc

Вот этому коду

Начал разбирать, но до таких программ мне еще далеко.
Коротко закомментировать сможешь?
Мне не понятно зачем нам изменять свойства (vla-put-startpoint line) и другие defun

VVA · 26.03.2015, 17:47

Есть готовое решение
Учти так же, что

Цитата:

Сообщение от Лентяй

Участвует потому, что метод vla-IntersectWith учитывает и блоки, но (ВНИМАМНИЕ!) учитывает не пересечение ЭЛЕМЕНТОВ БЛОКОВ, а их ГАБАРИТОВ (boundaries), получаемых методом vla-getBoundingBox.

tujn08 · 26.03.2015, 18:47

Цитата:

Сообщение от VVA

Есть готовое решение

От туда и брал часть кода. Как ни крути мне надо самому написать LISP иначе не разберусь. Про габариты блока знаю еще до программирования.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Объединение дуг, линий в единый объект, Как объединить?	Vladimir.P	AutoCAD	41	25.01.2015 08:03
Помогите отклассифицировать проектируемый объект.	Clod	Прочее. Архитектура и строительство	4	28.01.2012 20:59
Помогите расценить объект	Варюшенков Д.Е.	Разное	8	02.04.2010 16:24
Помогите преобразовать каркас спиральной канавки в твердотельный объект...	Sota	AutoCAD	12	06.01.2010 09:33
Помогите создать не AutoCAD-овский ARX объект	Caduser	AutoCAD	5	24.09.2004 07:59