[gabrin]

На форуме caduser http://www.caduser.ru/cgi-bin/f1/board.cgi?t=35011qE есть программа написанная для 3dpoly. Если кто знает как изменить код для LW polyline, и соединять объекты по методу звезда ( один с несколькими ), буду премного благодарен.

[Дима_]

Пример чего есть и чего требуеться на выходе программы покажи - а то, как практика показывает, 10 раз переписывать придеться.

[gabrin]

Сам же и отвечу

Код:

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

(defun c:plz( / snp nameset frstblc runblk korfir setlength
                nirnam nirest kornir brun korrun spis spold)

(setq snp (getvar "Osmode"))
(setvar "Osmode" 0)
(setq nameset (ssget "_:L" '(( 0 . "INSERT")))); imya nabora
(setq frstblc (car (entsel "Select First Block"))); imya pervovo bloka
(setq i 0)
(setq runblk (ssname nameset 0)); imya nulevogo
 (while         ; ishem pervi blok i udalyaem ego
    (not(equal runblk frstblc))
    (setq i (1+ i))
    (setq runblk (ssname nameset i)); imya po nomeru
 ); konec while
(if (equal runblk frstblc)
           (ssdel runblk nameset)
);konec if nashli i udalili
(setq korfir (assoc 10 (entget frstblc))); koord pervogo bloka(X Y Z)
(setq setlength (sslength nameset)); dlina nabora
(setq i -1)
  (repeat setlength
    (setq i (1+ i))
    (setq brun (entget(ssname nameset i))); spisok i
    (setq korrun(assoc 10 brun)) ; koordinati run(X Y Z)
    (setq spis (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline")
                          '(90 . 15) korfir korrun))
    (setq spold (entmake spis))
   ) ;repeat
(setvar "Osmode" snp)
)

На caduser.ru подсказали

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

Работать код не будет в общем случае. А если я выберу 1 блок? Или 100?

Код:

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

(defun c:pline-through-insert (/ adoc *error* _dwgru-conv-pickset-to-list)
  (defun *error* (msg)
    (vla-endundomark adoc)
    (princ msg)
    (princ)
    ) ;_ end of defun

  (defun _dwgru-conv-pickset-to-list (value / tab item)
    (repeat (setq tab  nil
                  item (sslength value)
                  ) ;_ end setq
      (setq tab (cons (ssname value (setq item (1- item))) tab))
      ) ;_ end repeat
    ) ;_ end defun

  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-StartUndoMark
  (if (setq selset (ssget '((0 . "INSERT"))))
    (entmakex (append
                (list '(0 . "LWPOLYLINE")
                      '(100 . "AcDbEntity")
                      '(100 . "AcDbPolyline")
                      (cons 90 (sslength selset))
                      ) ;_ end of list
                (mapcar '(lambda (x / tmp)
                           (setq tmp (cdr (assoc 10 (entget x))))
                           (cons 10 (list (car tmp) (cadr tmp)))
                           ) ;_ end of LAMBDA
                        (_dwgru-conv-pickset-to-list selset)
                        ) ;_ end of mapcar
                ) ;_ end of append
              ) ;_ end of entmakex
    ) ;_ end of if
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun