Формирование каталогов координат полилиний ???

;Вывод снформации щ вершинах полилиний в EXCEL в виде таблицы
;Номер | X | Y | Z | дистанция | Угол в радианах
;-------------------------
(defun C:PLtoEx (/ books c ccells cols dat excel k nbook next sheet sheets torel)
  (vl-load-com)
  (if (setq excel (vlax-get-or-create-object "Excel.Application"))
    (progn (setq books  (vlax-get-property excel 'workbooks)
                 nbook  (vlax-invoke-method books 'add 1)
                 sheets (vlax-get-property nbook 'worksheets)
                 sheet  (vlax-get-property nbook 'activesheet)
                 dat    (pl:get-apr-data)
                 c      0)
      (princ (strcat "\nПоиск точек завершён. Обработано полилиний: "
             (itoa (length dat))
             "\nНачинается сброс данных в Excel. Пожалуйста, ждите!"))
      (foreach v dat
    (princ (strcat "\nПолилиния: " (itoa (setq c (1+ c))) ", узлов: "
               (rtos (length v) 2 0)))
    (if next (setq torel (cons sheet torel) sheet (vlax-invoke-method sheets 'add)));if
    (setq ccells (vlax-get-property sheet 'cells)
          cols (vlax-get-property sheet 'columns) i 0);setq
    (foreach y v (setq i (1+ i) k 0)
      (foreach x y (setq k (1+ k)) (pl:put-real-to-cell ccells i k x)));foreach y
    (vlax-invoke-method cols 'autofit)
        (vlax-release-object cols)
        (vlax-release-object ccells)
        (setq next t)
      );foreach v
      (if torel (vlax-invoke-method (last torel) 'activate))
      (if (= (vlax-get-property excel 'visible) :vlax-false)
    (vlax-put-property excel 'visible :vlax-true))
      (foreach x (cons sheet
               (if torel (append torel (list sheets nbook books excel))
             (list sheets nbook books excel)));cons
    (vlax-release-object x));foreach x
    );progn
    (alert "Не могу запустить Excel!"));if
  (princ)
);end
;
(defun pl:get-apr-data (/ adoc ass coor par dist ang temp res)
  (setq adoc (vla-get-activedocument (vlax-get-acad-object))
        ass (vla-get-activeselectionset adoc))
  (vla-clear ass)
  (vla-selectonscreen ass
    (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 0)) '(0))
    (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 0)) '("*POLYLINE")))
  (vlax-for pl ass
    (setq coor (vlax-get pl 'Coordinates)
          par (vlax-curve-getEndparam pl))
    (while (>= par 0)
      (setq dist (apply '- (mapcar '(lambda (x) (vlax-curve-getDistAtParam pl x))
                             (list par (if (/= par 0) (1- par) 0))))
            coor (vlax-curve-getPointAtParam pl par)
            ang (angle '(0 0 0) (vlax-curve-getFirstDeriv pl par))
            temp (cons (cons (rtos par) (append coor (list dist ang))) temp)
            par (1- par)));while
    (setq res (cons temp res)));vlax-for
);defun
;
(defun pl:lst-to-lsts (lst modul / _pl:lst-to-lsts)
  (defun _pl:lst-to-lsts (slst i mod / tmp)
    (cond ((not slst) nil)
          ((zerop i) (cons (list (car slst)) (_pl:lst-to-lsts (cdr slst) mod mod)))
          (t (setq tmp (_pl:lst-to-lsts (cdr slst) (1- i) mod))
       (cons (cons (car slst) (car tmp)) (cdr tmp))));cond
  );drfun
  (_pl:lst-to-lsts lst (1- modul) (1- modul))
);dfun
;
(defun pl:put-real-to-cell (ccells x y val)
  (vlax-put-property (vlax-variant-value (vlax-get-property ccells 'item
        (vlax-make-variant x vlax-vbinteger) (vlax-make-variant y vlax-vbinteger)))
    "Value2" (vlax-make-variant val vlax-vbdouble))
);defun

(defun katalog (/ pl_nabor fname)
  (vl-load-com)
  (if
    (and
      (setq pl_nabor (ssget '((0 . "lwpolyline"))))
      (setq fname (getfiled "Выберите файл" "" "txt" 5))
    )
     (data-v-file
       fname
       (mapcar
     '(lambda (x / list_kt dlina)
        (setq list_kt (mapcar 'cdr
                  (vl-remove-if-not
                    '(lambda (y) (= (car y) 10))
                    (entget x)
                  )
              )
        )
        (if    (zerop (cdr (assoc 70 (entget x))))
          (setq list_kt (reverse (cdr (reverse list_kt))))
        )
        (setq
          dlina
           (mapcar
         '(lambda (z)
            (if    (/= (1+ (vl-position z list_kt))
                (length list_kt)
            )
              (list
            (distance
              z
              (nth (1+ (vl-position z list_kt)) list_kt)
            )
            (cond
              (
               (>
                 (setq ang
                    (angle
                      z
                      (nth (1+ (vl-position z list_kt))
                       list_kt
                      )
                    )
                 )
                 (/ pi 2)
               )
               (- (+ (* pi 2) (/ pi 2)) ang)
              )
              (t
               (- (/ pi 2) ang)
              )
            )
              )
              (list
            (distance z (car list_kt))
            (cond
              (
               (>
                 (setq ang
                    (angle z (car list_kt))
                 )
                 (/ pi 2)
               )
               (- (+ (* pi 2) (/ pi 2)) ang)
              )
              (t
               (- (/ pi 2) ang)
              )
            )
              )
            )
          )
         list_kt
           )
        )
        (list
          list_kt
          dlina
          (apply '+ (mapcar 'car dlina))
          (vlax-curve-getarea (vlax-ename->vla-object x))
        )
      )
     (vl-remove-if 'listp (mapcar 'cadr (ssnamex pl_nabor)))
       )
     )
  )
)
(defun data-v-file (fnam data / deskr)
  (if
    (setq deskr (open fnam "w"))
     (progn
       (foreach    i data
     (setq j 1)
     (write-line
       "_________________________________________________________________________"
       deskr
     )
     (write-line
       (strcat "N точки"    "\t"         "|"      "Координаты"
           "\t"        "\t"         "|"      "Меры линий"
           "\t"        "|"         "Дирекционные углы"
           "\t"        "|"
          )
       deskr
     )
     (write-line
       "_________________________________________________________________________"
       deskr
     )
     (mapcar '(lambda (a b)
            (write-line
              (strcat (itoa j)
                  "\t"
                  (rtos (car a) 2 2)
                  "\t"
                  (rtos (cadr a) 2 2)
                  "\t"
                  "\t"
                  (rtos (car b) 2 2)
                  "\t"
                  "\t"
                  (angtos (cadr b) 1 4)
              )
              deskr
            )
            (setq j (1+ j))
          )
         (car i)
         (cadr i)
     )
     (write-line
       "========================================================================="
       deskr
     )
     (write-line
       (strcat "Площадь объекта-" (rtos (nth 2 i) 2 2))
       deskr
     )
     (write-line
       (strcat "Периметр объекта-" (rtos (nth 3 i) 2 2))
       deskr
     )
       )
       (close deskr)
     )
  )
)

(vl-load-com)
(setq ang (getangle "\nУкажите угол:"))
(princ "\nУказанный угол до минут: ")
(princ(vl-string-subst  " градус " "d" (angtos ang 1 2)))
(princ "\nУказанный угол до секунд: ")
(princ(vl-string-subst  " градус " "d" (angtos ang 1 3)))

(setq ang (getangle "\nУкажите угол:"))
(setq ang (/ (* ang 180) pi))
(setq gradus (fix ang))
(setq minut (* (rem ang 1) 60.0))
(princ "\nУказанный угол ")(princ gradus)(princ " градусов ")
(princ minut)(princ " минут")

(defun jop (nkoh / katt katal ka kat fal)
  (setq NKOH (car(entsel"\nВыберите объект : ")))
  (setq NKOH1 (vlax-ename->vla-object nkoh))
  (vlax-dump-object NKOH1)
 (setq katt (vla-get-coordinates nkoh1))
  (setq katal (safearray-value (vlax-variant-value katt)))
(setq fal (open "c:/data/katalog.dat" "w"))
  (setq n (length katal))
  (setq ss 0)
    (while (< ss (1- n))
    (setq x (nth ss katal));извлечение икса
    (setq y (nth (1+ ss) katal));извлечение игрека
    (setq pt1 (list x y));получение пикета
    (setq ss (+ ss 2))
    (princ ";" fal)
    (princ (rtos y 2 2) fal);печать в файл икса
    (princ ";" fal)
    (princ (rtos x 2 2) fal);печать в файл игрека
    (setq uu pt1)
    (setq ka (cons uu ka)))
  (setq kat (reverse ka));формирование списка с координатами
  (setq lb (getstring"\nВведите маркировку точки : "))
(setq n (length kat))
(setq s 0)
(setq num 1)
(setq nuu num)
(setq num1 num)
(setq pto '(153.1555 153.00))
(while (< s n)
    (setq kt (nth s kat))
(setq kt2 (nth (1+ s) kat))
(if (= kt2 nil) (setq num1 (- nuu 1)) )
(if (= kt2 nil) (setq kt2 (nth 0 kat)) )
    (command"insert" "piket1" kt "1" "" "0")
    (setq kt1 (polar kt 0 3))
(setq numt (itoa num))
(setq numl (strcat lb numt))
    (command"text" kt1 "0" numl)
(setq pti (polar pto 4.7124 4.0))
(setq pto pti)
(setq ptdir (polar pti 0 24.72))
(setq ptd (polar pti 0 49.00))
  (setq dst (rtos (distance kt kt2) 2 2))
(setq n1 (strcat lb (itoa num)))
(setq num1 (1+ num1))
(setq n2 (strcat lb (itoa num1)))
(setq nd (strcat n1 "-" n2))
  (setq katx (rtos (cadr kt) 2 2))
(setq katy (rtos (car kt) 2 2))
(command"text" "m" pti "0" numl)
(command"text" "m" ptdir "0" katx)
(command"text" "m" ptd "0" katy)
    (setq num (1+ num))
    (setq s (+ s 1)))
  (setq katt nil)(close fal)
  )
(vl-load-com)
(jop nkoh)