[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

_____________________________________________________________________________________________________________

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

[Do$]

Можно так:

Код:

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

(setq lst '(5 7 2 1 9 0))
(setq min_numb (car (vl-sort lst (function <))))
(setq max_numb (car (vl-sort lst (function >))))

Писал без проверки в акаде.

[magiker]

Ну собственно именно так я сейчас и делаю... ну, почти так.
Просто думал, может есть какой-нить аналог (min) (max) для списка =)

[Do$]

Можно еще так:

Код:

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

(apply 'min lst)
(apply 'max lst)

[VVA]

Сообщение от magiker Просто думал, может есть какой-нить аналог (min) (max) для списка =)

Ну и еще для развития. Есть список точек с координатами X,Y.

Код:

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

(setq lst '((11 2)(2 5)(2 4)(3 1)))

Нужно из этого списка получить точку с минимальным X,Y и максимальным X,Y

Код:

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

(setq lst '((11 2)(2 5)(2 4)(3 1)))
(apply 'mapcar (cons 'min lst)) ;_Xmin Ymin
(apply 'mapcar (cons 'max lst)) ;_Xmax Ymax

[Дима_]

Сообщение от VVA Сначала дать свой вариант, потом смотреть здесь Код: (setq lst '((11 2)(2 5)(2 4)(3 1))) (apply 'mapcar (cons 'min lst)) ;_Xmin Ymin (apply 'mapcar (cons 'max lst)) ;_Xmax Ymax

Я не понимаю как это вобще работает???
p.s. - все понял - хитр'о.
p.p.s - тогда уж (mapcar '(lambda (f)(apply 'mapcar (cons f lst))) '(min max))

[superkot007]

Прошу прощения за назойливость...
Никто не может помочь с
http://forum.dwg.ru/showpost.php?p=562615&postcount=810
???

[Do$]

У меня в автокаде 2006 код работает.
Может быть код применялся не к отрезкам?

[VVA]

superkot007, У меня код так же работает. Может угол отклонения отрезка от оси больше указанного в команде

И еще - как его модернизировать, чтобы он еще и выравнивал концы отрезков по координатам, кратным, например, 5..

Написать другую команду

Код:

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

(defun C:L_ROUND_XY (/ ss en e p1 p2 i n dir d dr x y l dl)
;;;Команда выравнивает координаты концов отрезков блоков текстов
;;;согласно указанной точности
;;; Округление выравнивание
;;; http://forum.dwg.ru/showpost.php?p=564014&postcount=828
  (defun round (num prec)
    (* prec
       (if (minusp num)
         (fix (- (/ num prec) 0.5))
         (fix (+ (/ num prec) 0.5))
       ) ;_ end of if
    ) ;_ end of *
  ) ;_ end of defun

  (setvar "CMDECHO" 0)
  (if (null L_ROUND_XY)
    (progn
      (setq L_ROUND_XY 5.0)
    ) ;_ end of progn
  ) ;_ end of if
  (setq d (getreal
            (strcat "\nТочность округления координат <"
                    (rtos L_ROUND_XY 2 3)
                    ">: "
            ) ;_ end of strcat
          ) ;_ end of getreal
  ) ;_ end of setq
  (if d
    (setq L_ROUND_XY (abs d))
  ) ;_ end of if
  (princ "\nВыберите отрезки, тексты, блоки для выравнивания: ")
  (cond
    ((setq ss (ssget '((0 . "LINE,TEXT,INSERT"))))
     (setq i 0
           n (sslength ss)
     ) ;_ end of setq
     (while (< i n)
       (setq e (entget (ssname ss i)))
       (setq p1 (cdr (assoc 10 e))
             p2 (cdr (assoc 11 e))
       ) ;_ end of setq
       (if p1
       (setq p1 (list
                  (round (car p1) L_ROUND_XY) ;_X
                  (round (cadr p1) L_ROUND_XY) ;_Y
                  (caddr p1)                   ;_Z
                ) ;_ end of list
       ) ;_ end of setq
         )
       (if p2
       (setq p2 (list
                  (round (car p2) L_ROUND_XY) ;_X
                  (round (cadr p2) L_ROUND_XY) ;_Y
                  (caddr p2)                    ;_Z
                ) ;_ end of list
       ) ;_ end of setq
         )
       (if p1 (setq e (subst (cons 10 p1) (assoc 10 e) e)))
       (if p2 (setq e (subst (cons 11 p2) (assoc 11 e) e)))
       (entmod e)
       (setq i (1+ i))
     ) ;_ end of while
    )
    (t
     (princ "\nНичего не выбрано, или выбрано что-то не то!")
    )
  ) ;_ end of cond
  (princ)
)

[superkot007]

Сообщение от Do$ У меня в автокаде 2006 код работает. Может быть код применялся не к отрезкам?

Нифига не понял почему - но сейчас работает... И вперед точно использовались отрезки (сам чертил для проверки, точно были не полилинии - не использую). "Ничё не понимаю" (с) Ну да ладно, работает и хорошо... Спасибо за проверку!

VVA Все как всегда - безупречно. Спасибо!

Еще вопрос - можно сделать "разрывы" как, например, в MS Visio - при перемещении/удалении/добавлении отрезка "разрыв" изменяется соответствующим образом? И с проверкой принадлежности одинаковому слою??? "Топорный" вариант есть:

Код:

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

 (defun C:VRT (/ pt pt1 pt2 pt3 m1 m2 v VarOsMode)
 ;РАЗРЫВ ВЕРТИКАЛЬНЫХ ЛИНИЙ РАВНЫЙ 4мм
 (setq pt (getpoint "\n \n \nВведите точку пересечения линий:"))

; Отключить привязку
 (setq VarOsMode (getvar "osmode"))
 (setvar "osmode" 0)

 (setq pt1 (osnap pt "_int"))
 (setq m1 (+ (cadr pt1) 2))
 (setq pt2 (list (car pt1) m1))
 (setq m2 (- (cadr pt1) 2))
 (setq pt3 (list (car pt1) m2))
 (command "_break" pt2 pt3)

; Включить привязку
  (setvar "osmode" VarOsMode)

 )

Но когда начинаешь редактировать чертежи - можно мылить веревку...

[VVA]

Сообщение от superkot007 можно мылить веревку.

Почитай тему Хитрый блок Плюс его можно сделать динамическим с автовыравниванием

[superkot007]

Сообщение от VVA Почитай тему Хитрый блок Плюс его можно сделать динамическим с автовыравниванием

Ну я склонялся уже к "маскировке", думал, что какие еще решения интересные будут... Нашел вообще классический вариант - http://dwg.ru/art/14 Буду теперь "мучить" AutoCAD
Спасибо за наводку...

[alex8888]

Привет всем ,
подскажите для моей конструкции:

Код:

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

(defun save_new_dxf ( / )
  (command "_.wblock"
           (strcat
             	(getvar "dwgprefix")
                       (getvar "dwgname")
                       "-1");strcat
           "*");command
  );defun

1. Как сделать, чтобы при исходном имени "тырпыр.dwg" при выполнении программы вместо имени файла "тырпыр.dwg-1.dwg" получилось "тырпыр-1.dwg" ?
2. Что подставить вместо "*", чтобы была возможность выбрать конкретно, что сохранить (блоки, текст, уровни и тп)?

[Do$]

1. См. функции VL-FILENAME-BASE, VL-FILENAME-EXTENSION, SUBSTR.
2. Наверное, PAUSE.

[alex8888]

По п.1 исправил на следующую конструкцию:

Код:

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

(defun save_new_dxf (/)
  (vl-load-com)
  (command "_.wblock"
           (strcat
             (getvar "dwgprefix")
             (vl-filename-base (getvar "dwgname"))
             "-1"
           )                            ;strcat
           "*"
  )                                     ;command
)                                       ;defun

А вот Pause не помогает - спрашивает имя сохраненного блока или новый чертеж:

Namen des vorhandenen Blocks eingeben oder [= (block=ausgabedatei)/* (ganze zeichnung)] <Neue Zeichnung definieren>:

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

[Do$]

Честно говоря, никогда этой командой (wblock) не пользовался. Судя по описанию, с ее помощью можно сохранить блок чертежа в отдельном файле (вроде бы, только один). Поэтому, наверное, нужно из всего, что хочется сохранить в отдельный файл создать новый блок в чертеже, и уже его передавать в команду wblock. Опять же, с программным созданием блоков никогда не сталкивался (знаю только, что это возможно ), но, думаю, если поискать тут на форуме, то что-то по этой теме найдется.
Хотя, насчет одного блока - это я ошибся.
Вот так можно попробовать (без всяких проверок и пр.):

Код:

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

(defun c:test (/ ss)
  (vl-cmdf "_.copy"
    (setq ss (ssget))
    ""
    '(0.0 0.0 0.0)
    '(0.0 0.0 0.0)
  ) ;_ end of vl-cmdf
  (vl-cmdf "_.-wblock"
    (strcat
      (getvar "dwgprefix")
      (vl-filename-base (getvar "dwgname"))
      "-1"
    ) ;_ end of strcat
    ""
    (list 0.0 0.0 0.0)
    ss
    ""
  ) ;_ end of vl-cmdf
) ;_ end of defun

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

Еще один вариант:

Код:

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

(vl-load-com)

(defun c:test (/ adoc selsets selsetname vla_selset dwg_file wb_file)

  (setq selsets    (vla-get-selectionsets (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
        selsetname "wb"
        ) ;_ end of setq
  (if (/= (setq dwg_file (vla-get-fullname adoc)) "")
    (progn
      (vl-catch-all-apply
        (function
          (lambda ()
            (vla-delete (vla-item selsets selsetname))
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      (setq vla_selset (vla-add selsets selsetname))
      (if (and (not (vl-catch-all-error-p
                      (vl-catch-all-apply
                        (function
                          (lambda ()
                            (vla-selectonscreen vla_selset)
                            ) ;_ end of lambda
                          ) ;_ end of function
                        ) ;_ end of vl-catch-all-apply
                      ) ;_ end of vl-catch-all-error-p
                    ) ;_ end of not
               (> (vla-get-count vla_selset) 0)
               ) ;_ end of and
        (progn
          (vla-wblock (setq wb_file (strcat (vl-filename-directory dwg_file)
                                            "\\"
                                            (vl-filename-base dwg_file)
                                            "-1.dwg"
                                            ) ;_ end of strcat
                            ) ;_ end of setq
                      vla_selset
                      ) ;_ end of vla-Wblock
          (princ (strcat "\nНабор был сохранен в файл " wb_file))
          ) ;_ end of progn
        ) ;_ end of if
      (vl-catch-all-apply
        (function
          (lambda ()
            (vla-delete (vla-item selsets selsetname))
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      ) ;_ end of progn
    (alert "Файл не сохранялся еще ни разу! Выполнение невозможно!")
    ) ;_ end of if
  (princ)
  ) ;_ end of defun

[alex8888]

Кулик Алексей aka kpblc,
попытка выполнить твой лисп:
1. ругается на переопределение команды c:test, говорит что то про запрещенные символы и прерывания
2. при переименовании функции test в другую, в том числе и без с:, выскакивает Fehlerhafter Argumenttyp: VLA-OBJECT "G:\\Dateien-FH\\DrawingG\\DXF-LASER\\DXF von4401-4500\\4477-1.dwg" (ошибка типа аргумента), соответственно, на выходе нет
Каков алгоритм использует твоя программа? Можешь вкратце для чайника разъяснить

Do$,
после переименования test в другую функцию работает
Осталось только разобраться зачем введена команда copy и переменная ss

[Do$]

Да потому что я сделал код на скорую руку и для наглядности использовал командные методы. Команда "wblock" удаляет объекты после экспорта, поэтому пришлось сперва командой "copy" сделать копию объектов, которые собираемся экспортировать, поэтому и сохранение набора в переменной понадобилось... Использовать такое в качестве готовой функции, конечно же, нельзя!
У Алексея все довольно правильно сделано (вот не лень было заморочиться человеку ).
Алгоритм его функции прост - создается набор из объектов, передается в метод WBLOCK (оказывается и такое есть в VLA!) и при помощи него экспортируется в новый чертеж. Есть необходимые проверки и все "по уму".
Вставь то, что красным выделено в функцию и будет тебе счастье

Код:

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

(vla-wblock
     adoc
     (setq wb_file (strcat (vl-filename-directory dwg_file)
      "\\"
      (vl-filename-base dwg_file)
      "-1.dwg"
     ) ;_ end of strcat
     ) ;_ end of setq
     vla_selset
   ) ;_ end of vla-Wblock

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

Offtop: Во блин, ну надо же было так лохануться! Про указатель на документ забыл! Е-мое...

[alex8888]

Do$,

Использовать такое в качестве готовой функции, конечно же, нельзя!

вот взял и так уронил
Хотя все же заработало.

Конечно у Алексея все классно, но смысл то не только в том, что он пишет грамотно, кто бы сомневался, а в том чтобы тоже хоть граммулечку так же как и он научиться делать.

После добавки его лисп заработал как часы.
Спасибо.