[Red Nova]

Со школы не ладится у меня с программированием. Все предметы щелкал, а на экзамене по информатике (Visual foxpro) программку типа суммирования столбцов списал у соседа (это уже в университете).
Не смотря на эте намерен научится писать программы для Автокада на лиспе, скачал книгу Хювенена, несколько примеров создания программ, но после получасового “смотрения” таких книг мое мышление явно притормаживает.
Решил пойти другим путем.
Нашел самый короткий лисп из моей коллекции, и прошу программистов с этого форума пошагово объяснить какой символ что означает. Надеюсь на вашу помощь.

Код:

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

(defun c:make-blocks-explodeable (/ adoc)
  (vl-load-com)
  (vla-startundomark
    (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
    ) ;_ end of vla-startundomark
  (vlax-for blk_def (vla-get-blocks adoc)
    (if (and (equal (vla-get-isxref blk_def) :vlax-false)
             (equal (vla-get-islayout blk_def) :vlax-false)
             ) ;_ end of and
      (vl-catch-all-apply '(lambda () (vla-put-explodable blk_def :vlax-true)))
      ) ;_ end of if
    ) ;_ end of vlax-for
  (vla-endundomark adoc)
  (princ)
  ) ;_ end of defun

_____________________________________________________________________________________________________________

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

[pavelgeorgievich]

Сообщение от ciril Масштабы целочисленные? Проверка на превышения размеров ВЭ при заданном масштабе на выбранном шаблоне листа нужна? Примитивы с листа шаблона клонировать все или выборочно? На каком слое создавать ВЭ?

масштабы думаю стандартные необходимо (1:100, 1:50, 1:10 и т.д.)
проверку в принципе можно и не осуществлять, поскольку бывает, что и на А1 не помещаются чертежи
примитывы наверное все необходимы (в шаблоне обычно храню только рамку с основной надписью)
ВЭ в defpoints

[aso3]

Кулик Алексей aka kpblc, спасибо работает.

[ciril]

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

Начерно вот так, потом изменю, но пока ВЭ создается на текущем слое и почему-то ВЭ смещен от указанной области, но общую идею посмотреть уже можно. Проверь, подходит?
Масштаб вводить десятичной дробью, то есть, например, 1:100 = 0.01

Код:

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

 (defun c:layoutcreate  (/ x00 x01 x02 x03 x04 x05 x06 x07 x08)
  (setvar 'ctab "Model")
  (while (not (and (setq x00 (getpoint "\nУкажите первый угол рамки..."))
                   (setq x01 (getcorner x00 "\nУкажите второй угол рамки или <отменить>..."))))
    (princ "\nУкажите еще раз..."))
  (and (> (setq x02 (car x00)) (setq x03 (car x01)))
       (setq x00 (cons x03 (cdr x00))
             x01 (cons x02 (cdr x01))))
  (and (> (setq x02 (cadr x00)) (setq x03 (cadr x01)))
       (setq x00 (list (car x00) x03)
             x01 (list (car x01) x02)))
  (initget 6)
  (setq x02 (getreal "\nВведите масштаб видового экрана: "))
  (setq x03 (getfiled "\nВыбор файла шаблонов листов"
                      (vl-registry-read
                        (strcat (setq x03 (strcat (setq x03 (strcat "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\R" (substr (getvar 'acadver) 1 4)))
                                                  "\\"
                                                  (vl-registry-read x03 "CurVer")
                                                  "\\Profiles"))
                                "\\"
                                (vl-registry-read x03)
                                "\\General")
                        "TemplatePath")
                      "dwt"
                      16))
  (vl-load-com)
  (and (vl-catch-all-error-p
         (setq x04 (vl-catch-all-apply
                     'vla-open
                     (list (setq x05 (vla-getinterfaceobject
                                       (vlax-get-acad-object)
                                       (strcat "ObjectDBX.AxDbDocument."
                                               (if (>= (setq x05 (substr (getvar 'acadver) 1 2)) "16")
                                                 x05
                                                 ""))))
                           x03))))
       (vl-catch-all-error-message x04))
  (setq x03 ""
        x04 (vla-item (vla-get-dictionaries x05) "ACAD_LAYOUT")
        x06 (list)
        x07 -1)
  (repeat (length
            (setq x06 (cdr
                        (reverse
                          (while (not (vl-catch-all-error-p (setq x08 (vl-catch-all-apply 'vla-item (list x04 (setq x07 (1+ x07)))))))
                            (setq x06 (append x06 (list (vla-get-name x08)))))))))
    (setq x03 (strcat x03 (car x06) " ")
          x06 (cdr x06)))
  (initget 1 x03)
  (setq x06 (getkword (strcat "\nШаблоны листов: " x03 "\nВведите имя шаблона листа для вставки: ")))
  (while (or (zerop (setq x07 (1- x07))) (not (eq x06 (vla-get-name (setq x08 (vla-item x04 x07)))))))
  (and (vl-catch-all-error-p
         (setq x04 (vl-catch-all-apply
                     'vla-copyfrom
                     (list (setq x03 (vla-add (vla-get-layouts (setq x07 (vla-get-activedocument (vla-get-application (vlax-get-acad-object)))))
                                              x06))
                           x08))))
       (vl-catch-all-error-message x04))
  (setq x04 (list))
  (setvar 'ctab x06)
  (vla-copyobjects
    x05
    (vlax-make-variant
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbobject (cons 0 (1- (vla-get-count (vla-get-block x08)))))
        (vlax-for auxi (vla-get-block x08) (setq x04 (append x04 (list auxi))))))
    (setq x07 (vla-get-paperspace x07)))
  (vlax-release-object x05)
  (vla-getpapersize x03 'x04 'x05)
  (setq x06 (vla-addpviewport
              x07
              (vlax-make-variant
                (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble '(0 . 2)) (list (/ x05 2) (/ x04 2) 0.0)))
              (* x02 (abs (- (car x01) (car x00))))
              (* x02 (abs (- (cadr x01) (cadr x00))))))
  (vla-put-customscale x06 x02)
  (vla-put-target
    x06
    (vlax-make-variant
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbdouble '(0 . 2))
        (list (/ (+ (car x01) (car x00)) 2) (/ (+ (cadr x01) (cadr x00)) 2) 0.0))))
  (vla-put-viewporton x06 :vlax-true)
  (gc)
  (setview (list (cons 0 "VIEW")
                 (cons 2 "calc")
                 (cons 70 0)
                 (setq x03 (list 10 (/ x05 2) (/ x04 2)))
                 (cons 40 x05)
                 (cons 41 100.0)
                 (list 11 0.0 0.0 1.0)
                 (list 12 0.0 0.0 0.0)
                 (cons 42 1.0)
                 (cons 43 0.0)
                 (cons 44 0.0)
                 (cons 50 0.0)
                 (cons 71 0)
                 (cons 72 1)
                 (list 110 0.0 0.0 0.0)
                 (list 111 1.0 0.0 0.0)
                 (list 112 0.0 1.0 0.0)
                 (cons 79 0)
                 (cons 146 0.0))
           0)
  (princ))

[pavelgeorgievich]

Сообщение от ciril Начерно вот так, потом изменю, но пока ВЭ создается на текущем слое и почему-то ВЭ смещен от указанной области, но общую идею посмотреть уже можно. Проверь, подходит? Масштаб вводить десятичной дробью, то есть, например, 1:100 = 0.01

сегодня решил проверить. видимо из-за того что у меня возможно другая версия Автокада лисп прерывается после того как ввожу "имя листа шаблона для вставки"
пишет: ; ошибка: Ошибка Automation. Дублирующийся ключ

[Никита Ремизов]

Есть стандартная команда автокада Выбрать подобные(Selectsimilar). возможно ли написать лисп дополняющий эту команду параметром подобия "содержимое" для текста?

[ciril]

Сообщение от pavelgeorgievich сегодня решил проверить. видимо из-за того что у меня возможно другая версия Автокада лисп прерывается после того как ввожу "имя листа шаблона для вставки" пишет: ; ошибка: Ошибка Automation. Дублирующийся ключ

Эта ошибка из-за того, что в чертеже уже существует имя лист с таким же именем, как и у выбранного листа шаблона.

[pavelgeorgievich]

Сообщение от ciril Эта ошибка из-за того, что в чертеже уже существует имя лист с таким же именем, как и у выбранного листа шаблона.

изменил имя листа - получилось. спасибо за подсказку
возникла другая проблема: лисп к одному файлу с шаблоном относится нормально (например acad.dwt), а к другому нет (созданному мною A3.dwt) при вводе имени шаблона пишет: ; ошибка: Ошибка Automation. Отсутствует описание.
и еще:
1. лисп производит корректировку масштаба ВЭ в зависимости от формата листа. ввожу к примеру 0.01 или 0.1 и т.д. происходит корректриовка к масштабу 1:20 на лист А4 (причем не совсем точно. отрезок должен в масштабе быть длиной 50 мм, а получается 49.0808) можно убрать корректировку масштаба? лучше потом вручную править формат листа.
2. можно-ли чтобы по шаблону создавалась не вкладка листа в исходном файле, а отдельный файл с единственным листом с ВЭ на выделенную облась в исходном файле?

[ciril]

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

если можно, шаблон и чертеж, в который вставляешь, выложи, у меня как раз с масштабами вообще без проблем... с отдельным файлом - непонятно, а примитивы из исходного как там окажутся?

[pavelgeorgievich]

Сообщение от ciril с отдельным файлом - непонятно, а примитивы из исходного как там окажутся?

я думаю ссылкой в виде ВЭ. я в диспетчере подшивок это делаю простым перетаскиванием файла с чертежом в модели на лист отдельного файла. получается как внешняя ссылка

[ciril]

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

Был алгоритмический косяк с формирование шаблона запроса, поправил.

Код:

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

 (defun c:layoutcreate  (/ x00 x01 x02 x03 x04 x05 x06 x07 x08)
  (setvar 'ctab "Model")
  (while (not (and (setq x00 (getpoint "\nУкажите первый угол рамки..."))
                   (setq x01 (getcorner x00 "\nУкажите второй угол рамки или <отменить>..."))))
    (princ "\nУкажите еще раз..."))
  (and (> (setq x02 (car x00)) (setq x03 (car x01)))
       (setq x00 (cons x03 (cdr x00))
             x01 (cons x02 (cdr x01))))
  (and (> (setq x02 (cadr x00)) (setq x03 (cadr x01)))
       (setq x00 (list (car x00) x03)
             x01 (list (car x01) x02)))
  (initget 6)
  (setq x02 (getreal "\nУкажите масштаб видового экрана: "))
  (setq x03 (getfiled "\nВыбор файла шаблонов листов"
                      (vl-registry-read
                        (strcat (setq x03 (strcat (setq x03 (strcat "HKEY_CURRENT_USER\\Software\\Autodesk\\AutoCAD\\R" (substr (getvar 'acadver) 1 4)))
                                                  "\\"
                                                  (vl-registry-read x03 "CurVer")
                                                  "\\Profiles"))
                                "\\"
                                (vl-registry-read x03)
                                "\\General")
                        "TemplatePath")
                      "dwt"
                      16))
  (vl-load-com)
  (and (vl-catch-all-error-p
         (setq x04 (vl-catch-all-apply
                     'vla-open
                     (list (setq x05 (vla-getinterfaceobject
                                       (vlax-get-acad-object)
                                       (strcat "ObjectDBX.AxDbDocument."
                                               (if (>= (setq x05 (substr (getvar 'acadver) 1 2)) "16")
                                                 x05
                                                 ""))))
                           x03))))
       (vl-catch-all-error-message x04))
  (setq x03 ""
        x04 (vla-item (vla-get-dictionaries x05) "ACAD_LAYOUT")
        x06 (list)
        x07 -1)
  (while (not (vl-catch-all-error-p (setq x08 (vl-catch-all-apply 'vla-item (list x04 (setq x07 (1+ x07)))))))
    (setq x06 (append x06 (list (vla-get-name x08)))))
  (or (and (eq "Model" (car x06)) (setq x08 (cdr x06)))
      (and (eq "Model" (last x06)) (setq x08 (cdr (reverse x06))))
      (repeat (length (- (length x06) (length (setq x08 (cdr (member "Model" x06)))) 1))
        (setq x08 (cons (car x06) x08)
              x06 (cdr x06))))
  (repeat (length x08)
    (setq x03 (strcat x03 (car x08) " ")
          x08 (cdr x08)))
  (initget 1 x03)
  (setq x06 (getkword (strcat "\nШаблоны листов: " x03 "\nВведите имя шаблона листа для вставки: ")))
  (while (not (eq x06 (vla-get-name (setq x08 (vla-item x04 (setq x07 (1- x07))))))))
  (and (vl-catch-all-error-p
         (setq x04 (vl-catch-all-apply
                     'vla-copyfrom
                     (list (setq x03 (vla-add (vla-get-layouts (setq x07 (vla-get-activedocument (vla-get-application (vlax-get-acad-object)))))
                                              x06))
                           x08))))
       (vl-catch-all-error-message x04))
  (setq x04 (list))
  (setvar 'ctab x06)
  (vla-copyobjects
    x05
    (vlax-make-variant
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbobject (cons 0 (1- (vla-get-count (vla-get-block x08)))))
        (vlax-for auxi (vla-get-block x08) (setq x04 (append x04 (list auxi))))))
    (setq x07 (vla-get-paperspace x07)))
  (vlax-release-object x05)
  (vla-getpapersize x03 'x04 'x05)
  (setq x06 (vla-addpviewport
              x07
              (vlax-make-variant
                (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble '(0 . 2)) (list (/ x05 2) (/ x04 2) 0.0)))
              (* x02 (abs (- (car x01) (car x00))))
              (* x02 (abs (- (cadr x01) (cadr x00))))))
  (vla-display x06 :vlax-true)
  (vla-update x06)
  (vla-put-customscale x06 x02)
  (vla-update x06)
  (vla-put-target
    x06
    (vlax-make-variant
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbdouble '(0 . 2))
        (list (/ (+ (car x01) (car x00)) 2) (/ (+ (cadr x01) (cadr x00)) 2) 0.0))))
  (vla-update x06)
  (gc)
  (setview (list (cons 0 "VIEW")
                 (cons 2 "calc")
                 (cons 70 0)
                 (setq x03 (list 10 (/ x05 2) (/ x04 2)))
                 (cons 40 x05)
                 (cons 41 100.0)
                 (list 11 0.0 0.0 1.0)
                 (list 12 0.0 0.0 0.0)
                 (cons 42 1.0)
                 (cons 43 0.0)
                 (cons 44 0.0)
                 (cons 50 0.0)
                 (cons 71 0)
                 (cons 72 1)
                 (list 110 0.0 0.0 0.0)
                 (list 111 1.0 0.0 0.0)
                 (list 112 0.0 1.0 0.0)
                 (cons 79 0)
                 (cons 146 0.0))
           0)
  (princ))

вот в таком виде выбирает область, шаблон, имя листа, запрашивает масштаб, вставляет лист, вставляет видовой экран по масштабу. Странно, у меня масштабирует нормально. С подшивкой разберусь чуть позже.

[pavelgeorgievich]

Сообщение от ciril вот в таком виде выбирает область, шаблон, имя листа, запрашивает масштаб, вставляет лист, вставляет видовой экран по масштабу. Странно, у меня масштабирует нормально.

все. у меня теперь тоже все работает. и масштабирует нормально.

[La Persona]

Здравствуйте! Помогите, пожалуйста, решить небольшую проблему: есть список poln_spisok, пытаюсь его инвертировать и вывести в текстовый файл. На строке (setq spisok_pr (reverse poln_spisok)) автокад спотыкается и выдает сообщение ошибка: неверный тип аргумента: consp nil. В чем может быть загвоздка?

Код:

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

   (setq spisok_pr (reverse poln_spisok))
  (setq f (open "C:\\AutoLISP_files\\cp_file.txt" "w"))
  (foreach x spisok_pr (princ (strcat x "\n") f))
  (close f)

UPD.:
Без reverse та же ошибка выдается...

Код:

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

 (setq f (open "C:\\AutoLISP_files\\cp_file.txt" "w"))
(foreach x poln_spisok (princ (strcat x "\n") f))
(close f)

[0] "4115 ÏÊ 41+15 3859 1671"
[1] "4064 ÏÊ 40+64 3810 1687"
[2] "3999 ÏÊ 39+99 3748 1707"
[3] "3928 ÏÊ 39+28 3680 1729"
[4] "3836 ÏÊ 38+36 3593 1756"
[5] "3752 ÏÊ 37+52 3513 1782"
[6] "3686 ÏÊ 36+86 3450 1802"
[7] "3613 ÏÊ 36+13 3380 1825"
[8] "3543 ÏÊ 35+43 3314 1846"
[9] "3472 ÏÊ 34+72 3247 1867"
[10] "3390 ÏÊ 33+90 3168 1892"
[11] "3327 ÏÊ 33+27 3108 1912"
[12] "3260 ÏÊ 32+60 3044 1932"
[13] "3199 ÏÊ 31+99 2986 1951"
[14] "3147 ÏÊ 31+47 2936 1967"
[15] "3087 ÏÊ 30+87 2880 1985"
[16] "3018 ÏÊ 30+18 2814 2006"
[17] "2955 ÏÊ 29+55 2754 2025"
[18] "2886 ÏÊ 28+86 2689 2046"
[19] "2804 ÏÊ 28+04 2610 2071"
[20] "2714 ÏÊ 27+14 2539 2063"
[21] "2643 ÏÊ 26+43 2506 2000"
[22] "2582 ÏÊ 25+82 2478 1946"
[23] "2528 ÏÊ 25+28 2453 1898"
[24] "2436 ÏÊ 24+36 2411 1817"
[25] "2361 ÏÊ 23+61 2376 1749"
[26] "2306 ÏÊ 23+06 2351 1701"
[27] "2218 ÏÊ 22+18 2311 1623"
[28] "2158 ÏÊ 21+58 2283 1569"
[29] "2080 ÏÊ 20+80 2247 1500"
[30] "2023 ÏÊ 20+23 2221 1450"
[31] "1944 ÏÊ 19+44 2184 1379"
[32] "1858 ÏÊ 18+58 2145 1303"
[33] "1791 ÏÊ 17+91 2114 1244"
[34] "1702 ÏÊ 17+02 2073 1165"
[35] "1609 ÏÊ 16+09 2030 1083"
[36] "1537 ÏÊ 15+37 1997 1018"
[37] "1452 ÏÊ 14+52 1958 943"
[38] "1358 ÏÊ 13+58 1895 912"
[39] "1281 ÏÊ 12+81 1824 942"
[40] "1220 ÏÊ 12+20 1768 965"
[41] "1142 ÏÊ 11+42 1696 994"
[42] "1053 ÏÊ 10+53 1613 1029"
[43] "990 ÏÊ 09+90 1555 1053"
[44] "935 ÏÊ 09+35 1504 1074"
[45] "843 ÏÊ 08+43 1419 1109"
[46] "763 ÏÊ 07+63 1346 1139"
[47] "672 ÏÊ 06+72 1261 1174"
[48] "593 ÏÊ 05+93 1188 1204"
[49] "520 ÏÊ 05+20 1121 1231"
[50] "426 ÏÊ 04+26 1033 1268"
[51] "356 ÏÊ 03+56 969 1294"
[52] "286 ÏÊ 02+86 904 1321"
[53] "194 ÏÊ 01+94 819 1356"
[54] "138 ÏÊ 01+38 768 1377"
[55] "56 ÏÊ 00+56 692 1408"

[Do$]

Список в лиспе выглядит так: (<Элемент1> <Элемент2> <Элемент3> <Элемент4> <Элемент5> ... ), например:

Код:

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

 
(setq poln_spisok 
   (list 
       "4115 ПК 41+15 3859 1671"
       "4064 ПК 40+64 3810 1687"
       "3999 ПК 39+99 3748 1707"
       "3836 ПК 38+36 3593 1756" 
       ;;... и так далее
   )
)

[La Persona]

Co списком poln_spisok проблем нет, создается и заполняется в цикле нормально. Содержимое списка я взял из журнала трассировки. Непонятно, почему выходит ошибка, когда пытаюсь вывести содержимое списка в файл...

Насколько я понял, автокад переменную poln_spisok не считает списком. Хотя во время отладки poln_spisok отображается именно как список. Что-то я вообще запутался на ровном месте...

Код:

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

 
(vl-load-com)

(defun _dwgru-random (/ modulus multiplier increment)
;;; Генерирует случайное вещественное число в диапазоне от 0 до 1
;;; Используется глобальная переменная *DWGRU_SEED*
  (if (not *DWGRU_SEED*)
    (setq *DWGRU_SEED* (getvar "DATE"))
  )
  (setq    modulus    65536
    multiplier
     25173
    increment 13849
    *DWGRU_SEED*
     (rem (+ (* multiplier *DWGRU_SEED*) increment) modulus)
  )
  (/ *DWGRU_SEED* modulus)
)
(defun c:cp (/        pln       base_l     use_l     cp_coord
         num    num_str       suff_str   suff     cp_coord_x
         cp_coord_y    use_l_str  spis_str   poln_spisok
         sl_ch    step_l       spisok_pr  coord1     coord2
         f        x
        )
  (setq snp (getvar "Osmode"))
  (setvar "Osmode" 0)
  (setq
    k1 (getint "Минимальное расстояние между контрольными точками:"
       )
  )
  (setq
    k2 (getint
     "Максимальное расстояние между контрольными точками:"
       )
  )
  (setq b_name (getstring "Введите имя блока:"))
  (setq pln (car (entsel)))
  (setq    base_l
     (vlax-curve-getDistAtParam pln (vlax-curve-getEndParam pln))
  )
  (setq use_l 0)
  (while (<= use_l base_l)
    (progn
      (setq sl_ch (_dwgru-random))
      (setq step_l (+ (* sl_ch (- k2 k1)) k1))
      (setq use_l (+ use_l step_l))
      (setq cp_coord (vlax-curve-getPointAtDist pln use_l))
      (setq num (fix (/ use_l 100)))
      (if (< num 10)
    (setq num_str (strcat "0" (itoa num)))
    (setq num_str (itoa num))
      )
      (setq suff (- (fix use_l) (* num 100)))
      (if (< suff 10)
    (setq suff_str (strcat "0" (itoa suff)))
    (setq suff_str (itoa suff))
      )
      (setq cp_coord_x (fix (nth 0 cp_coord)))
      (setq cp_coord_y (fix (nth 1 cp_coord)))

      (setq
    coord1 (list (- cp_coord_x 10) (+ cp_coord_y 2))
      )
      (setq coord2
         (list (+ cp_coord_x 10) (+ cp_coord_y 12))
      )
      (setq spis_str (strcat (itoa (fix use_l))
                 " "
                 (strcat "ПК " num_str "+" suff_str)
                 " "
                 (itoa cp_coord_x)
                 " "
                 (itoa cp_coord_y)
             )
      )
      (setq poln_spisok (cons spis_str poln_spisok))
      (command "_.insert" b_name cp_coord 1.0 0)
      (command "_.mtext" coord1 coord2 (strcat "+" suff_str) "")
    )
  )
  (setvar "Osmode" snp)
  (setq spisok_pr (reverse poln_spisok))
  (setq f (open "C:\\AutoLISP_files\\cp_file.txt" "w"))
  (foreach x spisok_pr (princ (strcat x "\n") f))
  (close f)
)

[Do$]

По записи в файл все работает нормально. Проверял так:

Код:

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

 
(setq poln_spisok
       (list
	 "4115 IE 41+15 3859 1671"
	 "4064 IE 40+64 3810 1687"
	 "3999 IE 39+99 3748 1707"
	 "3928 IE 39+28 3680 1729"
	 "3836 IE 38+36 3593 1756"
	 "3752 IE 37+52 3513 1782"
	 "3686 IE 36+86 3450 1802"
	 "3613 IE 36+13 3380 1825"
	 "3543 IE 35+43 3314 1846"
	 "3472 IE 34+72 3247 1867"
	 "3390 IE 33+90 3168 1892"
	 "3327 IE 33+27 3108 1912"
	 "3260 IE 32+60 3044 1932"
	 "3199 IE 31+99 2986 1951"
	 "3147 IE 31+47 2936 1967"
	 "3087 IE 30+87 2880 1985"
	 "3018 IE 30+18 2814 2006"
	 "2955 IE 29+55 2754 2025"
	 "2886 IE 28+86 2689 2046"
	 "2804 IE 28+04 2610 2071"
	 "2714 IE 27+14 2539 2063"
	 "2643 IE 26+43 2506 2000"
	 "2582 IE 25+82 2478 1946"
	 "2528 IE 25+28 2453 1898"
	 "2436 IE 24+36 2411 1817"
	 "2361 IE 23+61 2376 1749"
	 "2306 IE 23+06 2351 1701"
	 "2218 IE 22+18 2311 1623"
	 "2158 IE 21+58 2283 1569"
	 "2080 IE 20+80 2247 1500"
	 "2023 IE 20+23 2221 1450"
	 "1944 IE 19+44 2184 1379"
	 "1858 IE 18+58 2145 1303"
	 "1791 IE 17+91 2114 1244"
	 "1702 IE 17+02 2073 1165"
	 "1609 IE 16+09 2030 1083"
	 "1537 IE 15+37 1997 1018"
	 "1452 IE 14+52 1958 943"
	 "1358 IE 13+58 1895 912"
	 "1281 IE 12+81 1824 942"
	 "1220 IE 12+20 1768 965"
	 "1142 IE 11+42 1696 994"
	 "1053 IE 10+53 1613 1029"
	 "990 IE 09+90 1555 1053"
	 "935 IE 09+35 1504 1074"
	 "843 IE 08+43 1419 1109"
	 "763 IE 07+63 1346 1139"
	 "672 IE 06+72 1261 1174"
	 "593 IE 05+93 1188 1204"
	 "520 IE 05+20 1121 1231"
	 "426 IE 04+26 1033 1268"
	 "356 IE 03+56 969 1294"
	 "286 IE 02+86 904 1321"
	 "194 IE 01+94 819 1356"
	 "138 IE 01+38 768 1377"
	 "56 IE 00+56 692 1408"
       ) ;_ end of list
) ;_ end of setq

(setq spisok_pr (reverse poln_spisok))
(if
  (and (setq fn	(getfiled "Куда сохранить?"
			  "C:\\AutoLISP_files\\cp_file.txt"
			  "txt"
			  1
		) ;_ end of getfiled
       ) ;_ end of setq
       (setq f (open fn "w"))
  ) ;_ end of and
   (progn
     (foreach x spisok_pr (princ (strcat x "\n") f))
     (close f)
   ) ;_ end of progn
) ;_ end of if

[La Persona]

Хм... Тогда почему мой список не желает обрабатываться?
(setq spisok_pr (reverse poln_spisok)) возвращает nil. Но ведь содержимое списка poln_spisok не пустое.. Вопрос по-прежнему открыт. Может есть ошибка в теле цикла, во время заполнения списка?

[Do$]

Код из моего сообщения нормально работает? Если да, то используйте этот кусок в своей программе. Если проблема не исчезнет - значит где-то в другом месте ошибка.

[La Persona]

Сообщение от Do$ Код из моего сообщения нормально работает? Если да, то используйте этот кусок в своей программе. Если проблема не исчезнет - значит где-то в другом месте ошибка.

Проблема, как я понял, не в этом куске кода. Ошибка возникает здесь: (setq spisok_pr (reverse poln_spisok)) возвращает nil. poln_spisok как-то криво создан наверно. Но причину ошибки так и не могу отловить. Где-то в цикле надо искать...

[Do$]

У меня разбираться желание напрочь пропало, когда я увидел кучу этих setq и переменных Ни комментариев, ни описания про назначение программы... Примера в dwg нет, на котором протестировать можно...

[La Persona]

Может так лучше выглядит

Код:

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

 (vl-load-com)

(defun _dwgru-random (/ modulus multiplier increment)
;;; Генерирует случайное вещественное число в диапазоне от 0 до 1
;;; Используется глобальная переменная *DWGRU_SEED*
  (if (not *DWGRU_SEED*)
    (setq *DWGRU_SEED* (getvar "DATE"))
  )
  (setq    modulus    65536
    multiplier
     25173
    increment 13849
    *DWGRU_SEED*
     (rem (+ (* multiplier *DWGRU_SEED*) increment) modulus)
  )
  (/ *DWGRU_SEED* modulus)
)

;;;Вычисление контрольных точек трубопровода, запись ПК и координат в текстовый файл

(defun c:cp (/        pln       base_l     use_l     cp_coord
         num    num_str       suff_str   suff     cp_coord_x
         cp_coord_y    use_l_str  spis_str   poln_spisok
         sl_ch    step_l       spisok_pr  coord1     coord2
         f        x
        )
  (setq snp (getvar "Osmode"))
  (setvar "Osmode" 0)
  (setq
    k1       (getint "Минимальное расстояние между контрольными точками:"
       )
    k2       (getint
         "Максимальное расстояние между контрольными точками:"
       )
    b_name (getstring "Введите имя блока:") ; имя блока для вставки в контрольных точках
    pln       (car (entsel)) ;  выбор полилинии
    base_l (vlax-curve-getDistAtParam pln (vlax-curve-getEndParam pln));полная длина т/п
    use_l  0 ; начальная длина пройденного пути
  )
  (while (<= use_l base_l)
    (progn
      (setq sl_ch    (_dwgru-random)  ;  случайное число
        use_l    (+ use_l (+ (* sl_ch (- k2 k1)) k1)) ; текущее значение пройденного расстояния
        cp_coord (vlax-curve-getPointAtDist pln use_l) ; вычисление координаты контрольной точки
        num         (fix (/ use_l 100)) ; префикс
        suff     (- (fix use_l) (* num 100)) ; суффикс
      )
      (if (< num 10)
    (setq num_str (strcat "0" (itoa num)))
    (setq num_str (itoa num))
      )    ; end if /// если num<10, то добавляется 0 перед числом
      (if (< suff 10)
    (setq suff_str (strcat "0" (itoa suff)))
    (setq suff_str (itoa suff))
      )    ; end if /// если suff<10, то добавляется 0 перед числом
      (setq cp_coord_x (fix (nth 0 cp_coord))
        cp_coord_y (fix (nth 1 cp_coord))
        spis_str   (strcat (itoa (fix use_l))
                   " "
                   (strcat "ПК " num_str "+" suff_str)
                   " "
                   (itoa cp_coord_x)
                   " "
                   (itoa cp_coord_y)
               ) ; создаем строчку со всеми данными контрольной точки
      )
      (setq poln_spisok (cons spis_str poln_spisok)) ; добавляем в список новую запись
      (command "_.insert" b_name cp_coord 1.0 0) ; вставляем блок
      (command "_.mtext"
           (list (- cp_coord_x 10) (+ cp_coord_y 2))
           (list (+ cp_coord_x 10) (+ cp_coord_y 12))
           (strcat "+" suff_str)
           ""
      ) ; добавляем текст около контр. точки
    ) ;end of progn
  ) ;end of progn
  (setvar "Osmode" snp)
  (setq spisok_pr (reverse poln_spisok))
  (if
    (and (setq fn (getfiled "Куда сохранить?"
                "C:\\AutoLISP_files\\cp_file.txt"
                "txt"
                1
          ) ;_ end of getfiled
     ) ;_ end of setq
     (setq f (open fn "w"))
    ) ;_ end of and
     (progn
       (foreach x spisok_pr (princ (strcat x "\n") f))
       (close f)
     ) ;_ end of progn
  ) ;_ end of if
) ; end of defun c:cp

Программка должна на трубе через каждые 50...100 м вставлять блоки (control_point), вычислять контрольные точки - пикет, длина от начала трубопровода, координаты. И все это сохранять в текстовом файле.