[allroad]

Товарищи!
помогите с программкой
по моей задумке, должна вернуть список точек только что начерченной полилинии
while почему-то не выдает список точек

(defun C:OPZONA()
(setq line (entget (entlast)))
(setq points (cdr (member '(39 . 0.0) line)))
(setq n (/ (- (length points) 1) 4))
(setq points+ (list))
(setq n1 0)
(while (<= n1 n)
(setq pt (cdr(nth n1 points)))
(cons pt points+)
(setq n1 (+ n1 4))
(print pt)
)

)

[PSW]

;****************************************************************
; Функция возвращает список всех точек полилинии, отрезка
; первый элемент кол-во точек полилинии
; ( 5 (0.0 0.0) (1.0 0.0) (0.0 2.0) (5.0 5.0) (10.0 -20.0)
;****************************************************************
(defun POLY (A1 / _P1 _A1 _A2 _TIP _A200 _N_MAX _N1 _N2 _I)
(setq _A2 (entget A1))
(setq _TIP (cdr (assoc 0 _A2)))
(setq _A200 NIL)
;**************************************************************
(if (= _TIP "LWPOLYLINE")
(progn
(setq _N_MAX (length _A2))
(setq _I 0)
(setq _ii 0)
(repeat _N_MAX
(setq _SP (nth _I _A2))
(if (= (car _SP) 10)
(progn
(setq _A200 (cons (cdr _SP) _A200))
(if (= _ii 0) (setq _T0 (cdr _SP)))
(setq _ii 1)
))

(setq _I (+ 1 _I))
) ;Repeat
(setq _CLOSE (cdr (assoc 70 _A2)))
(IF (= _CLOSE 1) (setq _A200 (cons _T0 _A200)))
(setq _N_MAX (length _A200))
(setq _A200 (reverse _A200))
(setq _A200 (cons _N_MAX _A200))
) ;progn
) ;if
;**************************************************************
(if (= _TIP "LINE")
(progn
(setq N1 (cdr (assoc 10 _A2)))
(setq N2 (cdr (assoc 11 _A2)))
(setq _A200 (list 2 N1 N2))
) ;progn
) ;if
;***************************************************************
(setq _A200 _A200)
);END DEFUN

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

Какой именно полилинии? Облегченной? 3д? Возвращать в мировой системе координат или объектной (если таковая существует)? Или, может, в текущей?
Добавлю: для любых полилиний (без проверок)

Код:

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

(defun test (ent                           /
             res                           _kpblc-conv-list-to-3dpoints
             _kpblc-conv-ent-pline-vertex-to-wcs
             )

  (defun _kpblc-conv-list-to-3dpoints (lst / res)
                                      ;|
*    Функция конвертации списка чисел в список 3-мерных точек.
*    Параметры вызова:
*	lst	список чисел
*    Примеры вызова:
(_kpblc-conv-list-to-3dpoints '(1 2 3 4 5 6)) ;-> ((1 2 3) (4 5 6))
(_kpblc-conv-list-to-3dpoints '(1 2 3 4 5))   ;-> ((1 2 3) (4 5 0.))
|;
    (cond
      ((not lst)
       nil
       )
      (t
       (setq res (cons (list (car lst)
                             (if (cadr lst)
                               (cadr lst)
                               0.
                               ) ;_ end of if
                             (if (caddr lst)
                               (caddr lst)
                               0.
                               ) ;_ end of if
                             ) ;_ end of list
                       (_kpblc-conv-list-to-3dpoints (cdddr lst))
                       ) ;_ end of cons
             ) ;_ end of setq
       )
      ) ;_ end of cond
    res
    ) ;_ end of defun

  (defun _kpblc-conv-ent-pline-vertex-to-wcs (ent / elevation normal)
                                             ;|
*    Функция получения координат легкой полилинии (LWPOLYLINE) в WCS. Возвращает
* список 3Д-точек
*    Автор: BOZ (http://www.autocad.ru/cgi-bin/f1/board.cgi?t=26461HC)
*    Оригинальный код:
(defun lwpoly_vert (lwpoly / plinee elev vnv)
  (setq	plinee (entget lwpoly)
	elev   (cdr (assoc 38 plinee))
	vnv    (cdr (assoc 210 plinee))
	) ;_ end of setq
  (mapcar
    (function (lambda (x) (trans (list (cadr x) (caddr x) elev) vnv 0)))
    (vl-remove-if-not (function (lambda (x) (= (car x) 10))) plinee)
    ) ;_ end of mapcar
  ) ;_ end of defun
*    Параметры вызова:
*	ent	ename-указатель на LWPOLYLINE (контроля не производится)
*    Примеры вызова:
(_kpblc-conv-ent-pline-vertex-to-wcs (car (entsel)))
|;
    (setq elevation (cdr (assoc 38 (entget ent)))
          normal    (cdr (assoc 210 (entget ent)))
          ) ;_ end of setq
    (if (not elevation)
      (setq elevation 0.)
      ) ;_ end of if
    (mapcar '(lambda (x) (trans (list (cadr x) (caddr x) elevation) normal 0))
            (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))
            ) ;_ end of mapcar
    ) ;_ end of defun

  (if (and (cond (ent)
                 (t (setq ent (entlast)))
                 ) ;_ end of cond
           (wcmatch (cdr (assoc 0 (entget ent))) "*POLYLINE")
           ) ;_ end of and
    (progn
      (cond
        ((= (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
         (setq res (_kpblc-conv-ent-pline-vertex-to-wcs ent))
         )
        ((= (cdr (assoc 0 (entget ent))) "POLYLINE")
         (setq res (_kpblc-conv-list-to-3dpoints
                     (vlax-safearray->list
                       (vlax-variant-value
                         (vla-get-coordinates (vlax-ename->vla-object ent))
                         ) ;_ end of vlax-variant-value
                       ) ;_ end of vlax-safearray->list
                     ) ;_ end of _kpblc-conv-list-to-3dpoints
               ) ;_ end of setq
         )
        ) ;_ end of cond
      ) ;_ end of progn
    ) ;_ end of if
  res
  ) ;_ end of defun

[allroad]

полилиния двухмерная! система координат мировая=)

[Zouss]

моя поделка для LWPOLYLINE (та, что командой _pline), дополненная кусочками кода из поста №7

Код:

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

(defun C:OPZ (/ ed ed1 n lpt elev)
  (and (setq ed (entget (entlast)))
       (= (cdr (assoc 0 ed)) "LWPOLYLINE")
       (progn
	 (setq elev (list (cdr (assoc 38 ed)))
	       n    (cdr (assoc 90 ed))
	       ed1  ed
	       lpt  nil
	 )
	 (repeat n
	   (setq lpt
		  (cons
		    (append
		      (cdr
			(assoc
			  10
			  (setq ed1 (member (assoc 10 (setq ed1 (cdr ed1))) ed1))
			)
		      )
		      elev
		    )
		    lpt
		  )
	   )
	 )
       )
  )
  (reverse lpt)
)

[allroad]

спасибо!=)работает!

[VVA]

Может так понятней будет. Для работы со списками есть функции foreach и assoc

Код:

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

(defun C:OPZONA( / line points+ elev)
(and (setq line (entget (entlast)))
     (= (cdr(assoc 0 line)) "LWPOLYLINE") ;_Полилиния
     (setq elev (list(cdr(assoc 38 line)))) ;_Уровень
     (foreach pt line
       ;;;Перебираем поля
       (if (= (car pt) 10) ;_Координата
         (setq points+ (cons (append (cdr pt) elev) points+))
         )
       )
     )
(reverse points+)
)