dwg.ru forum rss xml
| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 20.07.2008, 20:12
Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)
Red Nova
 
ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Торонто
Регистрация: 23.10.2007
Сообщений: 1,968
Отправить сообщение для Red Nova с помощью Skype™

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
_____________________________________________________________________________________________________________

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

Последний раз редактировалось Red Nova, 12.07.2017 в 05:43.
Просмотров: 1415849
 
Автор темы   Непрочитано 12.01.2018, 21:46
1 | #3441
Red Nova

ՃԱՐՏԱՐԱԳԵՏ, Տ.Գ.Թ.
 
Регистрация: 23.10.2007
Торонто
Сообщений: 1,968
Отправить сообщение для Red Nova с помощью Skype™


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
Offtop: Я бы постарался вообще обойтись без применения командных методов в *error*. Как-то не доверяю я подобному подходу...
Совсем не оф топ. Поменял в error возврат к мировой ucs c command на activeX и вроде как пока что все работает

Код:
[Выделить все]
 (defun c:test (/ i val *error*)
  (defun *error* (msg)
    (print (getvar "cecolor"))
    (princ " < color on start *error*")
    (foreach v val (setvar (car v) (cdr v)))
    (print (getvar "cecolor"))
    (princ " < color after variavle reset using foreach *error*")
    (kb:UCS:NameWorld t)
    (print "UCS reset *error*")
    (if	(and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
      (princ (strcat "\nError: " msg))
    )
    (vla-endundomark adoc)
    (print (getvar "cecolor"))
    (princ " < color after endundomar *error*")
  )
  (vl-load-com)
  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (print (getvar "cecolor"))
  (princ " < color on start test")
  (setq val (mapcar (function (lambda (v) (cons v (getvar v)))) '("clayer" "cecolor")))
  (setvar "cecolor" "1")
  (print (getvar "cecolor"))
  (princ " < color after cecolor 1")
  (command "ucs" "z" "45")
  (print "UCS rotated")
  (setq i 1)
  (while (< i 5000000) (setq i (1+ i)))
  (setvar "cecolor" "2")
  (print (getvar "cecolor"))
  (princ " < color after cecolor 2 (while completed)")
  (*error* nil)
  (print (getvar "cecolor"))
  (princ " < color on end test")
)

(defun kb:UCS:NameWorld (MakeActive / localUCS)
  (or g:activedoc (setq g:activedoc (vla-get-activedocument (vlax-get-acad-object))))
  (or g:ucss
      (setq g:ucss
             (vla-get-usercoordinatesystems (vla-get-activedocument (vlax-get-acad-object))
             )
      )
  )
  (setq localUCS (vla-add g:ucss
                          (vlax-3d-point '(0.0 0.0 0.0)) ;origin
                          (vlax-3d-point '(1.0 0.0 0.0)) ;x-axis
                          (vlax-3d-point '(0.0 1.0 0.0)) ;y-axis
                          "_WorldUCS"
                 )
  )
  (if MakeActive
    (vla-put-activeucs g:activedoc localUCS)
  )
  localUCS
)
Для себя сделал выводы.
в *error*
1. Не использовать mapcar
2. Не использовать командные методы.

Спасибо за помощь
__________________
Блог

Последний раз редактировалось Red Nova, 13.01.2018 в 00:04.
Red Nova вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 13.01.2018, 14:54
#3442
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 35,353


Есть еще вариант - вообще отказаться от переопределения *error*
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 28.01.2018, 04:24
#3443
mindchamber


 
Регистрация: 29.07.2017
Сообщений: 46


Подскажите пожалуйста как создать кнопку на загрузку лиспа в формате .fas?

Пробывал ^C^C load "NumeratorVertexPline01.fas" , почему-то не работает, хотя доверительную папку указал.

Спасибо.
mindchamber вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 28.01.2018, 18:08
1 | 1 #3444
engngr

сети
 
Регистрация: 03.11.2008
Московия*
Сообщений: 3,985
Отправить сообщение для engngr с помощью Skype™


^C^C(load "NumeratorVertexPline01.fas")
engngr вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 29.01.2018, 07:17
#3445
Setvar

Всего понемногу
 
Регистрация: 10.02.2007
Москва
Сообщений: 469


Есть команда "_LOAD" ("ЗАГРУЗИТЬ") для для выбора и загрузки в чертеж файла форм и есть функция AutoLisp (load) для загрузки файла приложения.
__________________
Установи FILEDIA в 1 и не парься.
Setvar вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 30.01.2018, 13:32
#3446
Titli-pytli


 
Регистрация: 23.10.2013
Сообщений: 22


Подскажите пожалуйста, как заставить редактор лиспа читать вот это "%<\AcVar SaveDate \f "MM.yy">%" как одну строку, а не как две и переменную MM.yy между ними?
Titli-pytli вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 30.01.2018, 14:31
#3447
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 35,353


Откуда считываешь? С текста/атрибута? Если да, кто мешает получать TextString, а не FieldCode?
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 30.01.2018, 23:46
#3448
engngr

сети
 
Регистрация: 03.11.2008
Московия*
Сообщений: 3,985
Отправить сообщение для engngr с помощью Skype™


Цитата:
Сообщение от Titli-pytli Посмотреть сообщение
читать вот это "%<\AcVar SaveDate \f "MM.yy">%" как одну строку
Перед " поставить \ или \\?
engngr вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 31.01.2018, 13:17
#3449
skkkk

AutoCAD_2008->2011
 
Регистрация: 20.03.2008
Московская область
Сообщений: 2,187


Надо перед всеми кавычками и обратными слэшами ставить обратный слэш.
skkkk на форуме вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 13.02.2018, 11:36
#3450
kurstep


 
Регистрация: 27.01.2012
Сообщений: 195


Здравствуйте, подскажите пожалуйста красивую и лаконичную функцию или еще лучше лямбда-функцию которая бы принимала два значения - количество элементов, и элемент - и выдавала список из одинаковых элементов:
то есть чтобы это работало так (func 5 "элемент") -> ("элемент" "элемент" "элемент" "элемент" "элемент")


Пробую так, почему-то не получается :
Код:
[Выделить все]
 ((lambda (count i / el) repeat count ( setq el (cons i el))) 5 "el")

Последний раз редактировалось kurstep, 13.02.2018 в 11:59.
kurstep вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 13.02.2018, 12:01
1 | #3451
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 35,353


Фигню-с написал.

----- добавлено через ~2 мин. -----
((LAMBDA(count i / res) (repeat count (setq res (cons i res))) res) 2 "i")
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 14.02.2018, 13:43
#3452
Fedorino

автоматизация и организация черчения
 
Регистрация: 17.11.2009
Sterlitamak
Сообщений: 118


Здравствуйте! Такая проблема. Исходные данные:
имеется блок, прямоугольной формы, размерами допустим 100х100 мм, левая нижняя точка его лежит в начале координат 0,0,
имеется точка (setq pt '(50 50)).
Вопрос, как выяснить попадает ли точка в область блока или нет?
Решал с помощью ssget, ничего не помогает, везде nil.
Код:
[Выделить все]
 
(ssget pt) - nil
(ssget pt '((0 . "INSERT"))) - nil
(ssget "_F" (list pt (mapcar '+ '(1 1) pt))) - nil
(ssget "_F" (list pt (mapcar '+ pt  '(1 1)))) - nil
(ssget "_WP" (list pt (mapcar '+ '(1 1) pt))) - nil
(ssget "_WP" (list pt (mapcar '+ pt  '(1 1)))) - nil
(ssget "_CP" (list pt (mapcar '+ '(1 1) pt))) - nil
(ssget "_CP" (list pt (mapcar '+ pt  '(1 1)))) - nil
(ssget "_W" pt (mapcar '+ '(1 1) pt)) - nil
(ssget "_W" pt (mapcar '+ pt  '(1 1))) - nil
(ssget "_C" pt (mapcar '+ '(1 1) pt)) - nil
(ssget "_C" pt (mapcar '+ pt  '(1 1))) - nil
Если pt присвоить (setq pt (0 0)), то блок сразу попадает в набор.
Подскажите метод определяющий попадет ли точка в область блока!
__________________
слесарь САПР
Fedorino вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 14.02.2018, 14:42
#3453
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 35,353


Тут две задачи
1. Определить область блока. Вопрос на форуме поднимался, советую заняться поиском
2. Определить вхождение точки в контур (может быть, даже не существующий) - тоже поднимался на форуме. Опять же, поиск.
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 15.02.2018, 16:27
#3454
Doctor_Che


 
Регистрация: 27.10.2015
Сообщений: 18


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

Идея такая - код подсчитывает количество вхождений каждого вида блоков. Блоки динамические. Названия блоков могут быть типа: ИМЯ_БЛОКА_ХХ, где ХХ - версия блока.
На выходе получается: количество светильников - 25 шт., количество выключателей - 3 шт., количество розеток - 8 шт. и т.д.
Код:
[Выделить все]
 ;; (vl-load-com)

;;;Глобальная переменная имени блока светильника
(setq block_name_lamp "ЭО_Светильник")

;;;Глобальная переменная имени блока выключателя
(setq block_name_switch "ЭТО_Выключатель")

;;;Глобальная переменная для маски добавляемой к имени блока
(setq block_name_mask "_##")

;;;-----------------------------------------------------------------------------------------------;;;
;;;Функция замера времени выполнения кода;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;-----------------------------------------------------------------------------------------------;;;
(setq BenchStart nil)
(defun BenchTime (start / millisecs)
  (if start
    (setq BenchStart (getvar "Millisecs"))
    (if BenchStart
      (progn
        (princ (strcat "\nElapsed: " (rtos (* 0.001 (- (getvar "Millisecs") BenchStart)))))
        (setq BenchStart nil)
      )
      (princ "\nThere's an error. The bechmark wasn't started yet.")
    )
  )
  t
)

;;;-----------------------------------------------------------------------------------------------;;;
;; Get Anonymous References  -  Lee Mac
;; Returns the names of all anonymous references of a block.
;; blk - [str] Block name/wildcard pattern for which to return anon. references
;;;-----------------------------------------------------------------------------------------------;;;

(defun LM:getanonymousreferences (blk / ano def lst rec ref)
  (setq blk (strcase blk))
  (while (setq def (tblnext "block" (null def)))
    (if
      (and (= 1 (logand 1 (cdr (assoc 70 def))))
     (setq rec
      (entget
        (cdr
          (assoc 330
           (entget
             (tblobjname
         "block"
         (setq ano (cdr (assoc 2 def)))
             )
           )
          )
        )
      )
     )
      )
       (while
   (and
     (not (member ano lst))
     (setq ref (assoc 331 rec))
   )
    (if
      (and
        (entget (cdr ref))
        (wcmatch (strcase (LM:al-effectivename (cdr ref))) blk)
      )
       (setq lst (cons ano lst))
    )
    (setq rec (cdr (member (assoc 331 rec) rec)))
       )
    )
  )
  (reverse lst)
)

;;;-----------------------------------------------------------------------------------------------;;;
;; Effective Block Name  -  Lee Mac
;; ent - [ent] Block Reference entity
;;;-----------------------------------------------------------------------------------------------;;;
(defun LM:al-effectivename (ent / blk rep)
  (if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**")
    (if
      (and
  (setq rep
         (cdadr
     (assoc -3
      (entget
        (cdr
          (assoc 330
           (entget
             (tblobjname "block" blk)
           )
          )
        )
        '("acdbblockrepbtag")
      )
     )
         )
  )
  (setq rep (handent (cdr (assoc 1005 rep))))
      )
       (setq blk (cdr (assoc 2 (entget rep))))
    )
  )
  blk
)

;;;-----------------------------------------------------------------------------------------------;;;
;;;Список имен всех блоков;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;-----------------------------------------------------------------------------------------------;;;
(defun ax:blocks (block / b bn tl)
  (vlax-for b (vla-get-blocks
                (vla-get-ActiveDocument (vlax-get-acad-object))
              )
              (if (= (vla-get-islayout b) :vlax-false)
                (if (wcmatch (vla-get-name b) block) ;;;Add Doctor_Che 2018-01-16
                    (setq tl (cons (vla-get-name b) tl))
                )
              )
  )
  (reverse tl)
)

;;;-----------------------------------------------------------------------------------------------;;;
;; Flatten List  -  Lee Mac
;; Transforms a nested list into a non-nested list with null values removed
;;;-----------------------------------------------------------------------------------------------;;;
(defun LM:flatten-nils ( l )
    (if l
        (if (atom l)
            (list l)
            (append (LM:flatten-nils (car l)) (LM:flatten-nils (cdr l)))
        )
    )
)

;;;-----------------------------------------------------------------------------------------------;;;
;;;Преобразование списка в строку;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;-----------------------------------------------------------------------------------------------;;;
(defun LM:BlockList->Str (lst del / f)
  ;; © Lee Mac 2011

  (defun f (s) (if (wcmatch s "`**") (strcat "`" s) s))

  (if (cdr lst)
    (strcat (f (car lst)) del (LM:BlockList->Str (cdr lst) del))
    (f (car lst))
  )
)

;;;-----------------------------------------------------------------------------------------------;;;
;;;Проверка на совпадение имени (анонимного имени) блока с указаной строкой;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;-----------------------------------------------------------------------------------------------;;;
(defun check-blockname-blockanonymousname (block_name / tmp)
  (setq tmp (cdr (assoc 2 (entget temp_name_one_object))))
  (or
    (member tmp (LM:getanonymousreferences (strcat block_name block_name_mask)))
    ;; (member tmp (LM:getanonymousreferences block_name))
    (wcmatch tmp (strcat  block_name block_name_mask))
    ;; (wcmatch tmp block_name)
  )
)

;;;-----------------------------------------------------------------------------------------------;;;
;;;Функция выбора объектов и подсчёта их количества;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;-----------------------------------------------------------------------------------------------;;;
(defun C:calculation-of-equipment ( / temp_name_one_object temp_count temp_list )

                    ;;;list_selected_objects   - переменная хранения и передачи списка выбранных линий
                    ;;;temp_name_one_object      - временная переменная хранения имени одной из выбранных линии
                    ;;;temp_count              - временная переменная хранения значения количества выбранных линий
                    ;;;temp_list               - временная переменная хранения списка

  (BenchTime t)
  (setq
    temp_list (list block_name_lamp block_name_switch)  ; создаём список из базовых имён блоков обозначений устройств для подключения
    temp_list (mapcar '(lambda (x) (strcat x block_name_mask)) temp_list)  ; добавляем к базовым именам блоков маску ("_##")
    temp_list (LM:BlockList->Str (append '("") (LM:flatten-nils (mapcar 'ax:blocks temp_list)) (LM:flatten-nils (mapcar 'LM:getanonymousreferences temp_list))) ",") ; производим поиск всех анонимных имён блоков по маскам и переводим результат в строку
  )
  (princ "\nНа создание списка имён блоков потрачено времени: ")
  (BenchTime nil)

  (princ "\n Укажите объекты которые должны быть включены в кабельный блок: \n")
  (BenchTime t)
  (setq list_selected_objects   ;| стартуем выбор объектов с условием |;
    (ssget
      (list
        (cons -4 "<OR")
          (cons -4 "<AND")
            (cons 0 "INSERT")
            (cons 2 temp_list)
            (cons 66 1)
          (cons -4 "AND>")
          (cons -4 "<AND")
            (cons 0 "ARC,ELLIPSE,*LINE")
            (cons -4 "<NOT")
              (cons -4 "<AND")
                (cons 0 "POLYLINE")
                (cons -4 "&")
                (cons 70 80)
              (cons -4 "AND>")
            (cons -4 "NOT>")
          (cons -4 "AND>")
        (cons -4 "OR>")
      ) ; end list
    ) ; end ssget
  ) ; end setq
  (princ "\nНа создание набора потрачено времени: ")
  (BenchTime nil)

  (if
    list_selected_objects
    (progn
        (BenchTime t)
        (setq
          G_count_lamp 0.0    ;| обнуляем или задаём первичное количество светильников в наборе |;
          G_count_switch 0.0    ;| обнуляем или задаём первичное количество выключателей в наборе |;
        )
        (repeat (setq temp_count (sslength list_selected_objects))    ;| выполняем пока не кончится список |;
            (setq temp_name_one_object (ssname list_selected_objects (setq temp_count (1- temp_count)))) ;| перебираем элементы набора |;
            (if (= (cdr (assoc 0 (entget temp_name_one_object))) "INSERT") ; если тип элемента это INSERT (блок)
              (progn
                (if (check-blockname-blockanonymousname block_name_lamp) ; проверяем подходит ли текущий проверяемый блок к блоку с именем block_name_lamp
                  (setq G_count_lamp (1+ G_count_lamp)) ;| добавляем к количеству светильников в наборе |;
                ) ; end if
                (if (check-blockname-blockanonymousname block_name_switch) ; проверяем подходит ли текущий проверяемый блок к блоку с именем block_name_switch
                  (setq G_count_switch (1+ G_count_switch)) ;| добавляем к количеству выключателей в наборе |;
                ) ; end if
              ) ; end progn
            ) ; end if
        ) ; end repeat
        (princ "\nНа подсчёт объектов потрачено времени: ")
        (BenchTime nil)
    ) ; end progn

    (progn
        (alert "Ничего не было выбрано!\nПрограмма будет закрыта!") ; если ничего не выбрали, то выходим.
        (exit)
    ) ; end progn
  ) ; end if

  (setq list_selected_objects nil) ; обнуляем переменную хранения выбора объектов
  (princ "\nСветильников выбрано: ")
  (princ G_count_lamp)
  (princ "\nВыключателей выбрано: ")
  (princ G_count_switch)
  (princ)
)   ; end defun calculation-of-equipment
Doctor_Che вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 15.02.2018, 16:37
1 | #3455
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,687


Doctor_Che, посмотри альтернативные варианты:
http://www.lee-mac.com/nestedblockcounter.html
http://www.lee-mac.com/blockcounter.html
Nike вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 15.02.2018, 18:35
1 | #3456
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,665
Отправить сообщение для VVA с помощью ICQ Отправить сообщение для VVA с помощью Skype™


Doctor_Che, Замени анализ имени блока и всех его динамических представлений на сравнение эффективного имени и маски wcmatch
Т.е допустим, если динамические блоки светильника имеют имя "Светильник_01", "СвелильниК_02" и т.п.
то
Цитата:
(if (check-blockname-blockanonymousname block_name_lamp) ; проверяем подходит ли текущий проверяемый блок к блоку с именем block_name_lamp
(setq G_count_lamp (1+ G_count_lamp)) ;| добавляем к количеству светильников в наборе |;
) ; end if
замени на
Код:
[Выделить все]
(setq block_name_lamp_mask "СВЕТИЛЬНИК_*") ;_Маска для блоков свельника
(if (wcmatch (strcase (vla-get-effectivename
                        (vlax-ename->vla-object temp_name_one_object)
                      ) ;_ end of vla-get-EffectiveName
             ) ;_ end of strcase
             block_name_lamp_mask
    ) ;_ проверяем подходит ли текущий проверяемый блок к блоку с именем block_name_lamp
  (setq G_count_lamp (1+ G_count_lamp))
  ;| добавляем к количеству светильников в наборе |;
) ;_ end if
и убери комментарий с 1 строчки (vl-load-com)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 16.02.2018 в 11:50.
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 16.02.2018, 10:58
#3457
Doctor_Che


 
Регистрация: 27.10.2015
Сообщений: 18


VVA, спасибо огромное. Теперь фрагмент с подсчётом блоков просто летает!
А можно ли оптимизировать момент с выбором блоков?
Там у меня идея такая, что бы выбирались только определённые типы блоков (светильники, выключатели и т.д.), если выбор идёт рамкой. И что бы все левые объекты отсеивались. Потом я всё что удовлетворяет требованию упаковываю в блок.
Вот здесь я создаю список всех вхождений блоков, которые удовлетворяют условию.
Код:
[Выделить все]
   (setq
    temp_list (list block_name_lamp block_name_switch)  ; создаём список из базовых имён блоков обозначений устройств для подключения
    temp_list (mapcar '(lambda (x) (strcat x block_name_mask)) temp_list)  ; добавляем к базовым именам блоков маску ("_##")
    temp_list (LM:BlockList->Str (append '("") (LM:flatten-nils (mapcar 'ax:blocks temp_list)) (LM:flatten-nils (mapcar 'LM:getanonymousreferences temp_list))) ",") ; производим поиск всех анонимных имён блоков по маскам и переводим результат в строку
  )
А здесь выбор с фильтром:
Код:
[Выделить все]
     (ssget
      (list
        (cons -4 "<OR")
          (cons -4 "<AND")
            (cons 0 "INSERT")
            (cons 2 temp_list)
            (cons 66 1)
          (cons -4 "AND>")
          (cons -4 "<AND")
            (cons 0 "ARC,ELLIPSE,*LINE")
            (cons -4 "<NOT")
              (cons -4 "<AND")
                (cons 0 "POLYLINE")
                (cons -4 "&")
                (cons 70 80)
              (cons -4 "AND>")
            (cons -4 "NOT>")
          (cons -4 "AND>")
        (cons -4 "OR>")
      ) ; end list
    ) ; end ssget
Может есть альтернатива?
Doctor_Che вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 16.02.2018, 12:13
1 | #3458
VVA

Инженер LISP
 
Регистрация: 11.05.2005
Минск
Сообщений: 6,665
Отправить сообщение для VVA с помощью ICQ Отправить сообщение для VVA с помощью Skype™


Я думаю будет быстрее в ssget отфильтровать только блоки (ssget '((0 . "INSERT")), а затем пробежаться по полученному набору и удалить блоки, у которых эффективное имя не соответствует маске wcmatch см #3456
затем SSSETFIRST подсветить нужные
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 16.02.2018, 12:28
1 | #3459
Nike

Шаражпроектхалтурмонтаж
 
Регистрация: 29.10.2004
Талды-Париж
Сообщений: 5,687


А не проще было бы блоки размещать в своих слоях (светильники в слое "Светильники", выключатели в "Выключатели" и т.д.) и выбирать с фильтром по слою?
Nike вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 16.02.2018, 13:50
#3460
Doctor_Che


 
Регистрация: 27.10.2015
Сообщений: 18


Цитата:
Сообщение от Nike Посмотреть сообщение
А не проще было бы блоки размещать в своих слоях (светильники в слое "Светильники", выключатели в "Выключатели" и т.д.) и выбирать с фильтром по слою?
Точно. У меня не каждый тип блока в своём слое, а каждый раздел. Но это как раз подошло.
Сделал фильтрацию (sget '((cons 0 "INSERT")(cons 8 "ЭО*,ЭМ*"))) - скорость выросла до реактивной.
Doctor_Che вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Научите лиспу на примере (или как kpblc, VVA и компания пытаются обучить чайника лиспу)

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
LISP. Вставка в таблицу поля, соотвествующего площади примитива Profan Готовые программы 261 04.05.2018 12:45
Сейсмозащита и сейсмоизоляция существующих, построенных зд. IANationalInformAgentstvo Прочее. Архитектура и строительство 216 20.01.2015 16:51
Мониторы LCD CRT Разное 94 17.06.2008 10:51
ЮМОР 2006 =) Perezz!! Разное 1122 04.01.2007 00:46

|| Главная || Каталог САПР || Тендеры || Публикации || Объявления || Биржа труда || Download || Галерея ||
|| Библиотека || Кунсткамера || Каталог предприятий || Контакты || Файлообменник || Блоги ||