Как создать маркер c использованием acadЛИСП?
| Правила | Регистрация | Пользователи | Сообщения за день |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Как создать маркер c использованием acadЛИСП?

Как создать маркер c использованием acadЛИСП?

Ответ
Поиск в этой теме
Непрочитано 03.09.2009, 09:26 #1
Как создать маркер c использованием acadЛИСП?
Serge_BN
 
инженер
 
Оренбург
Регистрация: 18.04.2007
Сообщений: 71

Маркер или выноска, которая имеет следующий формат
Код:
[Выделить все]
маркер: однострочный_текст
;
однострочный_текст:префикс дефис инфиксы постфикс
;
префикс: текст
;
дефис: пусто
  | пробел
  | '-'
  | '.'
;
инфиксы: пусто
  | инфикс разделитель
  | инфикс разделитель инфиксы
;
инфикс: целое
;
разделитель: '.'
  | '-'
  | '/'
;
постфикс: целое
;
При этом постфикс начинается с 0 и при каждой последующей вставке увеличивается на 1
при смене префикса либо инфикса постфикс сбрасывается в 0.
Вначале выполнения команды задаются все ~фиксы, количество инфиксов, т.е. желательно, просто ввести К-1.1.0, либо ткнуть в существующий маркер, команда должна его распознать и от него продолжить далее. По умолчанию, например (U-1.1.0).
Соответственно должна быть предусмотрена возможность изменения префикса, инфикса при выполнении команды.
Так же должна быть возможность задать произвольный постфикс.

Последний раз редактировалось Serge_BN, 07.09.2009 в 08:48.
Просмотров: 4575
 
Непрочитано 03.09.2009, 09:36
#2
Profan


 
Регистрация: 25.12.2005
Москва
Сообщений: 13,627


Хоть бы пример привел, а то сплошная фикса.
Profan вне форума  
 
Автор темы   Непрочитано 03.09.2009, 09:47
#3
Serge_BN

инженер
 
Регистрация: 18.04.2007
Оренбург
Сообщений: 71


Цитата:
Сообщение от Profan Посмотреть сообщение
Хоть бы пример привел, а то сплошная фикса.
U-1.1.0, U-1.1.1, U-1.1.2 ...U-1.1.100, U-1.2.0, U-1.2.1...
R-1, R-2, R-3....
K-1.1.1.0, K-1.1.1.1, K-1.1.1.2.....
C 1, C 2, C 3....
DD1, DD2, DD3...
Serge_BN вне форума  
 
Непрочитано 03.09.2009, 22:11
#4
Кулик Алексей aka kpblc
Moderator

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


Попробуй поиск по форуму (слово "автонум*") - может, и найдешь решение.
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 04.09.2009, 10:44
#5
E-degtyarev

Помогаю, кому делать нечего.
 
Регистрация: 27.03.2009
Русская деревня
Сообщений: 394


Вот набросал наспех.
Код:
[Выделить все]
(defun C:mar ()
  (defun poz_rus ()
    (setq stroka (strcat telo1 post1))
    (setq dlina (strlen stroka))
    (while (setq st (getpoint "\nУкажите точку начала выноски : "))
      (setq st1 st)
      (setq en (getpoint st "\nСледующая точка выноски : "))
      (setq en1 en)
      (command "_Circle" st 0.25)
      (command "_Line" st en "")
      (setq st en)
      (setq sm (getpoint st "\nУкажите сторону отрисовки полочки : "))
      (if (<= (car st) (car sm))
	(progn
	  (setq sm (polar st 0.0 (* dlina 4)))
	  (command "_Line"
		   st
		   sm
		   ""
	  )
	  (command "_Text"
		   (list (car st) (+ (cadr st) 1.5))
		   5.0
		   0.0
		   stroka
	  )
	)
	(progn
	  (setq sm (polar st pi (* dlina 4)))
	  (command "_Line"
		   st
		   sm
		   ""
	  )
	  (command "_Text"
		   (list (- (car st) (* dlina 4)) (+ (cadr st) 1.5))
		   5.0
		   0.0
		   stroka
	  )
	)
      )
      (setq post_1 (+ 1 post_1))
      (setq post1 (itoa post_1))
      (setq stroka (strcat telo1 post1))
    )
  )
  (defun prisvoen ()
    (setq telo1 (get_tile "telo"))
    (setq post1 (get_tile "post"))
    (setq post_1 (atoi post1))
  )
  (defun poz (/ dcl_id)
    (setq dcl_id (load_dialog "marker.dcl"))
    (new_dialog "poz" dcl_id)
    (set_tile "telo" telo1)
    (set_tile "post" post1)
    (action_tile "MyOK" "(prisvoen)(done_dialog)")
    (action_tile "cancel" "(done_dialog)")
    (start_dialog)
    (unload_dialog dcl_id)
  )
  (if (= telo1 nil)
    (setq telo1 "U.U.U")
  )
  (if (= post1 nil)
    (setq post1 "1")
  )
  (poz)
  (poz_rus)
)
Код:
[Выделить все]
poz : dialog {
 	label = "МАРКЕР";
 	:row {
 		:edit_box {
 		label = "Тело";
		 key = "telo";
 		}
 		:edit_box {
 		label = "Постфикс";
		 key = "post";
 		}
 }
 : row {
       : button {
	        label = "Выполнить";
		key = "MyOK";
       }
       cancel_button;
 }
}
E-degtyarev вне форума  
 
Автор темы   Непрочитано 04.09.2009, 15:14
#6
Serge_BN

инженер
 
Регистрация: 18.04.2007
Оренбург
Сообщений: 71


Спасибо всем, кто откликнулся.
Позволю себе несколько уточнить задачу.
Начнем с примера
U-1.1.0
здесь U это префикс и он может быть любым, т.е. должна быть возможность задать его в виде набора символов (U, DD, AA, etc);
- черточка это дефис, он тоже может быть любым из набора символов '-', '.',' ', либо его может и не быть вовсе;
первая единица - это инфикс - просто целое число, которое задается;
точка за первой единицей - это разделитель из набора символов '.', '-', '/', ' ', последнее это пробел, присутствует в выражении обязательно. Разелитель и дефис в одном выражении могут быть разными, а могут и совпадать, поэтому это разные синтаксические конструкции;
вторая единица - это тоже инфикс;
точка за ним это разделитель;
инфиксов может быть произвольное количество либо вообще может и не быть;
0 - это постфикс или суффикс, к нему должна применятся операция инкремент, т.е. его значение увеличивается каждый раз на 1 начиная с некоторого заданного значения.

В первом свое посте я привел синтаксическую нотацию данного маркера. Это просто описание синтаксиса данного регулярного выражения. Никаких пояснений я не привел в надежде на то, что программисты понимают без дополнительных разъяснений что это такое.
Так вот задачу можно перефразировать следующим образом.
1. Необходимо создать генератор регулярного выражения с указанным синтаксисом.
2. Создать парсер, который будет разбирать поданное ему на вход регулярное выражение и, если оно соответствует указанному синтаксису, то принимать его выделяя из него синтаксические конструкции - префикс, инфикс, постфикс и разделители, создавая при этом список значений и принимая его за образец для генерации последующих выражений.
Это необходимо для того, что бы при использовании данной команды мне не надо было каждый раз вводить все параметры регулярного выражения, а я мог бы просто ткнуть в существующее регулярное выражение, которое послужит образцом либо задать образец прямо в командной строке, например ВВ1-2. Тем самым избавляясь от необходимости создавать диалоги, иметь кучу опций и прочие неудобства.
Кроме того, имея такой парсер можно будет создать команду, которая будет анализировать весь текст, выбирать из него те выражения, которые будут соответствовать данному регулярному выражению, подсчитывать число типов вхождений по префиксу, заполнять спецификацию, да и еще много чего можно придумать. И при этом можно обходиться без блоков, без атрибутов. А если нужны дополнительные данные для заполнения, к примеру спецификации, всегда можно создать обычный текстовый файл, в котором будут хрвнится эти данные и выбирать их от туда по ключу, значением которого выступает префикс регулярного выражения.
Serge_BN вне форума  
 
Непрочитано 04.09.2009, 16:04
#7
E-degtyarev

Помогаю, кому делать нечего.
 
Регистрация: 27.03.2009
Русская деревня
Сообщений: 394


Прочитав пост №6, захотелось напиться. Никогда не думал, что я такой тупой.Так Вам маркер или базу данных?

Последний раз редактировалось E-degtyarev, 04.09.2009 в 16:34.
E-degtyarev вне форума  
 
Автор темы   Непрочитано 07.09.2009, 08:25
#8
Serge_BN

инженер
 
Регистрация: 18.04.2007
Оренбург
Сообщений: 71


Мне нужен только маркер. Но этот маркер должен быть в состоянии сгенерировать и разобрать регулярное выражение указанного типа.
У меня создается такое впечатление, что необходимо еще растоковать что такое регулярное выражение, хотя, все же я надеюсь на то, что господа программисты, обитающие на этом форуме, все же знают что такое регулярное выражение и что такое синтаксис регулярного выражения и как он записывается. Ну и можно обратиться к вики http://ru.wikipedia.org/wiki/%D0%A0%...BD%D0%B8%D1%8F
На С или С++ такого рода программа делается со скоростью с которой вы можете набивать текст и никаких трудностей не предствляет. В использовании лиспа у меня очень малый опыт, поэтому я и обратился сюда. И мне нужна программа на лиспе именно в такой постановке - обработка регулярного выражения указанного типа.
Serge_BN вне форума  
 
Непрочитано 07.09.2009, 08:43
#9
E-degtyarev

Помогаю, кому делать нечего.
 
Регистрация: 27.03.2009
Русская деревня
Сообщений: 394


Извините, здесь к сожалению не все профессиональные программисты.
Я, например, инженер-механик, работаю конструктором, программироыванием балуюсь по долгу службы. Если Вы профессиональный программист, Вам должно быть легко освоить еще один язык. Классический Lisp достаточно прост для понимания.
А разбираться с парсерами грабберами и регулярными выражениями мне
уже не по годам.
С уважением, E-degtyarev.
E-degtyarev вне форума  
 
Автор темы   Непрочитано 07.09.2009, 09:29
#10
Serge_BN

инженер
 
Регистрация: 18.04.2007
Оренбург
Сообщений: 71


Цитата:
А разбираться с парсерами грабберами и регулярными выражениями мне
уже не по годам.
Способность мыслить это неотъемлемая способность и она не теряется с возрастом. Ее, правда, можно на время отключать, например пивом, но я думаю, мы не об этом . Спасибо за поддержку.
Serge_BN вне форума  
 
Непрочитано 07.09.2009, 09:42
#11
Кулик Алексей aka kpblc
Moderator

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


По-моему, именно из-за неопределенности префикса и разделителя нарисовывается некоторая проблема: к примеру, текст 11.1.1 - его как разбирать? Может, я просто не задал префикс? Или он равен "1"?
По идее надо вводить какие-то ограничения. Или я ошибаюсь?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 07.09.2009, 10:37
#12
Serge_BN

инженер
 
Регистрация: 18.04.2007
Оренбург
Сообщений: 71


Да, я не расписал достаточно подробно префикс.
Префикс это текст.
А текст это буква за которой следуют буквы.
В этом случае разночтений не возникнет потому как
за префиксом следует дефис, это либо '-', либо '.', либо ничего, либо пробел. И даже в случае "ничего" следующим символом будет цифра (и еще цифры). И если за ней следует точка или другой разделитель, то это инфикс, которого может быть несколько. Если разделителя нет, то это однозначно постфикс.

Тотже синтаксис, но другими словами и более сжато
[a-zA-Z]+[-|\.|' ']?([0-9]+[\.|-])*[0-9]+
где ? это один из указанных символов, которого может и не быть
+ это один или более
* это 0 или более
под данный синтаксис попадают выражения
DD-1, DD-2, DD1, DD2
A-1.1.2, А-1.2.5
К1.2, К1.3
Е-1.12.41.1000.100
и т.д
DD, A, K, E это префиксы. И префикс по условию присутствует всегда.
Привожу исправленный синтаксис.
Код:
[Выделить все]
маркер: однострочный_текст
;
однострочный_текст:префикс дефис инфиксы постфикс
;
префикс: буквы
;
буквы: буква
  | буква буквы
;
буква: а-яА-я | а-zА-Z
;
дефис: пусто
  | пробел
  | '-'
  | '.'
;
инфиксы: пусто
  | инфикс разделитель
  | инфикс разделитель инфиксы
;
инфикс: целое
;
разделитель: '.'
  | '-'
  | '/'
;
постфикс: целое
;

Последний раз редактировалось Serge_BN, 07.09.2009 в 11:31.
Serge_BN вне форума  
 
Непрочитано 08.09.2009, 15:10
#13
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Код:
[Выделить все]
(defun test (str / prefix defis infix postfix)
 (setq prefix ""
       defis ""
       infix ""
       postfix ""
 ) ;_  setq
  ;префикс
 (while (wcmatch (substr str 1 1) "@")
  (setq prefix (strcat prefix (substr str 1 1))
        str    (substr str 2)
  ) ;_  setq
 ) ;_  while
  ;дефис
 (if (wcmatch (substr str 1 1) "-,`., ")
  (setq defis (substr str 1 1)
        str   (substr str 2)
  ) ;_  setq
 ) ;_  if
  ;инфикс c постфиксом
 (while
  (progn (while (wcmatch (substr str 1 1) "#")
          (setq postfix (strcat postfix (substr str 1 1))
                str     (substr str 2)
          ) ;_  setq
         ) ;_  while
         (if (wcmatch (substr str 1 1) "-,`.,`/")
          (setq infix   (strcat infix postfix (substr str 1 1))
                postfix ""
                str     (substr str 2)
          ) ;_  setq
         ) ;_  if
  ) ;_  progn
 ) ;_  while
 (mapcar 'cons
         (list "префикс"     "дефис"
               "инфикс"      "постфикс"
               "остаток"
              ) ;_  list
 ;_  list
 ;_  list
         (if (= str "")
          (list prefix defis infix postfix)
          (list prefix defis infix postfix str)
         ) ;_  if
 ) ;_  mapcar
) ;_  defun
Использование
Код:
[Выделить все]
(test "Е-1.12.41.1000.100")
-> (("префикс" . "Е") ("дефис" . "-") ("инфикс" . "1.12.41.1000.") ("постфикс" . "100"))
(test "Е-1.12.41.1000.100A")
->(("префикс" . "Е") ("дефис" . "-") ("инфикс" . "1.12.41.1000.") ("постфикс" . "100") ("остаток" . "A"))
(test "DD2")
->(("префикс" . "DD") ("дефис" . "") ("инфикс" . "") ("постфикс" . "2"))
CB вне форума  
 
Автор темы   Непрочитано 08.09.2009, 15:45
#14
Serge_BN

инженер
 
Регистрация: 18.04.2007
Оренбург
Сообщений: 71


О, это чудо! Это работает! И даже, еще получаем остаток.
Просто замечательно.
По ходу дела у меня есть вопросы. Функция wsmatch принимает в качестве параметра некое выражение. В хелпе я не нашел правила и синтаксис этих выражений. В частности символы @, #, где можно найти подробнее об этом? Почему написано '. и '/ я догадываюсь, но, опять-таки, где это можно прочитать?
И следующее, если вас не затруднит, обратная задача.
Сгенерировать по заданному шаблону выражение с инкрементом постфикса. Пожалуйста.
Serge_BN вне форума  
 
Непрочитано 08.09.2009, 17:15
#15
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Вооще-то в хэлпе всё по функции wcmatch есть, но можешь еще почитать и здесь.
Код:
[Выделить все]
;разбираем регулярное выражение
(setq lst (test "А-1.2.10"))
;инкрементируем постфикс
(setq
 lst (subst
      (cons
       "постфикс"
       (rtos
        (1+ (atoi (cdr (assoc "постфикс" lst))))
        2
        0
       ) ;_  rtos
      ) ;_  cons
      (assoc "постфикс" lst)
      lst
     ) ;_  subst
) ;_  setq
;собираем регулярное выражение
(apply 'strcat (mapcar 'cdr lst))
CB вне форума  
 
Автор темы   Непрочитано 09.09.2009, 08:33
#16
Serge_BN

инженер
 
Регистрация: 18.04.2007
Оренбург
Сообщений: 71


Спасибо за дополнительную инфу.
Пытаюсь понять как это работает и заодно начинаю осознавать, что лисп обладает очень большой мощьностью при минимальном количестве выразительных средств.
Интересно, как бы можно было создать на нем некий шаблон конечного автомата со стеком для обработки контекстно свободных грамматик? Но это так, пока теория.
Я впишу в код свои комменты. Если что не правильно, поправьте, плз.
Код:
[Выделить все]
;разбираем регулярное выражение
(setq lst (test "А-1.2.10"))
;инкрементируем постфикс
(setq
 lst (subst
      (cons
       "постфикс"
       (rtos
        (1+ (atoi (cdr (assoc "постфикс" lst))))
;asscos возвращает из lst список ассоциированный с "постфикс"
;cdr берет из него остаток, т.е. строку со значением постфикса
;atoi преобразовывает строку в число
;1+ увеличивает на 1 это число
        2
        0
       ) ;_  rtos
;rtos преобразовывает число в строку
      ) ;_  cons
;cons создает новый список ("постфикс" . "число")
      (assoc "постфикс" lst)
;здесь еще раз assoc ??? :(
      lst
     ) ;_  subst
;subst заменяет в списке lst список "постфикс" на новый "список "постфикс"
) ;_  setq
;собираем регулярное выражение
(apply 'strcat (mapcar 'cdr lst))
А вот как работает сборка, я что-то не очень понимаю. Смысл, наверное, таков,что cdr возвращает хвосты, содержащие значения элементов шаблона и потом strcat из этих значений собирает строку.
Не понятно вот что, зачем нужны операции ' и как работает mapcar в паре с apply.

И в завершении этого цикла необходим некий драйвер для использования написанных функций.
т.е. вызывается команда, например mmark (make marker), она запрашивает образец, который можно ввести в командной строке либо указать мышкой в существующий на чертеже, после чего команда запрашивает точку вставки сформированного маркера, потом следующую точку и т.д. пока не будет нажата клавиша Esc. либо правая кнопка мыши Пожалуйста.

Замечание. Протестировал функцию (test "21A-1.2.10") и пр. с намеренными "неправильными" выражениями. Обнаружил побочный эффект. 21A-1.2.10 попало в остаток??? и естественно инкремент не может быть применен. Т.е. получается, что все выражения попадают под эту грамматику. Это не правильно. Функция, все-таки должна вернуть либо nil либо пустой список (что удобнее и правильнее??) в случае, если тестируемое выражение не удовлетворяет шаблону регулярного выражения.

Последний раз редактировалось Serge_BN, 09.09.2009 в 08:50.
Serge_BN вне форума  
 
Непрочитано 09.09.2009, 10:41
#17
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Цитата:
;cons создает новый список ("постфикс" . "число")
(assoc "постфикс" lst)
;здесь еще раз assoc ???
Фукнкция subst имеет следующий синтаксис : (subst newitem olditem lst)
Здесь
Код:
[Выделить все]
(cons
   "постфикс"
     (rtos
       (1+ (atoi (cdr (assoc "постфикс" lst))))
        2
        0
      ) ;_  rtos
 )
- newitem (новый подсписок)
Код:
[Выделить все]
(assoc "постфикс" lst)
- olditem (заменяемый подсписок в списке lst)
Цитата:
зачем нужны операции '
' это сокращенная запись функции quote. В данном случае cdr интерпретирунтся как ФУНКЦИЯ, хотя могла бы быть и переменной. Разные формы записи данного выражения:
Код:
[Выделить все]
(mapcar 'cdr lst)
(mapcar (quote cdr) lst)
(mapcar (function cdr) lst)
(mapcar '(lambda (x) (cdr x)) lst)
(mapcar (function (lambda (x) (cdr x))) lst)
Как работает apply почитай в хелпе - (apply 'function lst), т.е. она выполняет function, аргументы которой заданы списком:
Код:
[Выделить все]
 
(strcat "a" "b" "c")
(apply 'strcat '("a" "b" "c")) 
(apply (function strcat) '("a" "b" "c"))
(apply (function strcat) (list "a" "b" "c"))
Так вот (mapcar 'cdr lst) и есть аргументы для ф-ции strcat.

Цитата:
Протестировал функцию (test "21A-1.2.10") и пр. с намеренными "неправильными" выражениями...
Код:
[Выделить все]
 
(setq lst (test "21A-1.2.10"))
-> (("префикс" . "") ("дефис" . "") ("инфикс" . "") ("постфикс" . "21") ("остаток" . "A-1.2.10"))
Я намеренно делал результирующий список в такой форме, потому что проанализировать его на "неправильность" не представляет никаких трудностей - в "правильном" списке ОБЯЗАТЕЛЬНО не должен быть "префикс" и "постфикс" равным ("") и отсутствовать "остаток". Естественно этот анализ должен проводится в программе, которая запускает функцию test.
Возвращает Т для "правильного" списка:
Код:
[Выделить все]
 
(and (/= (cdr (assoc "префикс" lst)) "")
     (/= (cdr (assoc "постфикс" lst)) "")
     (not (assoc "остаток" lst))
)
Цитата:
[FONT=Verdana]вызывается команда, например mmark (make marker), она запрашивает образец, который можно ввести в командной строке либо указать мышкой в существующий на чертеже, после чего команда запрашивает точку вставки сформированного маркера, потом следующую точку и т.д. пока не будет нажата клавиша Esc. либо правая кнопка мыши[/FONT]
Как я понимаю новый сформированный маркер и последующие должены вставляться с инкрементом постфикса?

Последний раз редактировалось CB, 09.09.2009 в 11:54.
CB вне форума  
 
Автор темы   Непрочитано 09.09.2009, 12:01
#18
Serge_BN

инженер
 
Регистрация: 18.04.2007
Оренбург
Сообщений: 71


Спасибо.
Цитата:
Как я понимаю новый сформированный маркер и последующие должены вставляться с инкрементом постфикса?
Да, именно так.
Serge_BN вне форума  
 
Непрочитано 10.09.2009, 12:45
#19
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Цитата:
вызывается команда, например mmark (make marker), она запрашивает образец, который можно ввести в командной строке либо указать мышкой в существующий на чертеже, после чего команда запрашивает точку вставки сформированного маркера, потом следующую точку и т.д. пока не будет нажата клавиша Esc. либо правая кнопка мыши
Переход от ввода с командной строки на выбор образца - ПКМ, выход из цикла - ESC. Пока не получилось нормально обработать такую ситуацию: вводим образец из камандной строки, на чертеже нет ни одного объекта - не вставив образец в чертеж пытаемся выйти из команды по Esc -> не выходит из цикла. В этой ситуации нужно хотя бы один образец вставить в чертеж. Может есть и еще что-либо - сильно не тестировал...
PS: Естественно функция test, сделанная раньше, должна быть загружена.
Код:
[Выделить все]
(defun c:mmark (/ obj l lst pt str b)
 (if
  (progn
   (setq
    l (list (cons 1 (getstring "\nВведите образец: "))
            '(0 . "TEXT")
            (cons 40 (getvar "TEXTSIZE"))
      ) ;_  list
   ) ;_  setq
   (if (/= (cdar l) "")
    (setq lst (test (cdar l))
          obj t
    ) ;_  setq
    (progn (setq obj (car (entsel "\nВыберите образец: ")))
           (if obj
            (setq obj (entget obj)
                  l   (mapcar '(lambda (x) (assoc x obj)) '(1 0 7 8 62 40))
                  obj nil
                  lst (test (cdar l))
            ) ;_  setq
           ) ;_  if
    ) ;_  progn
   ) ;_  if
  ) ;_  progn
  (if (and (/= (cdr (assoc "префикс" lst)) "")
           (/= (cdr (assoc "постфикс" lst)) "")
           (not (assoc "остаток" lst))
      ) ;_  and
   (progn
    (setq pt (cadr (grread 5)))
    (while (if b
            (setq b (entnext b))
            (or (setq b (entlast)) t)
           ) ;_  if
     (if (not obj)
      (setq lst
            (subst
             (cons
              "постфикс"
              (rtos (1+ (atoi (cdr (assoc "постфикс" lst))))
                    2
                    0
              ) ;_  rtos
             ) ;_  cons
             (assoc "постфикс" lst)
             lst
            ) ;_  subst
      ) ;_  setq
      (setq obj nil)
     ) ;_  if
     (setq str (apply 'strcat (mapcar 'cdr lst)))
     (vl-cmdf
      "_cutclip"
      (entmakex
       (append (cdr l)
               (list (cons 1 str) (cons 10 pt))
       ) ;_  append
      ) ;_  entmakex
      ""
      "_pasteclip"
      pause
     ) ;_  vl-cmdf
     (setq pt (getvar "lastpoint"))
    ) ;_  while
   ) ;_  progn
   (princ "\nОбразец не соответствует синтаксису")
  ) ;_  if
  (princ "\nОбразец не выбран")
 ) ;_  if
 (princ)
) ;_  defun

Последний раз редактировалось CB, 10.09.2009 в 16:49.
CB вне форума  
 
Автор темы   Непрочитано 10.09.2009, 15:42
#20
Serge_BN

инженер
 
Регистрация: 18.04.2007
Оренбург
Сообщений: 71


Команду протестировал. Работает нормально и по Esc выходит в пустом чертеже. Огромное спасибо. Получилось то, что надо. Уже применяю в работе.

Некоторые строки мне не понятны

Код:
[Выделить все]
(setq
    l (list (cons 1 (getstring "\nВведите образец: "))
;Я так понимаю, что сдесь предлагается ввести образец маркера, но для чего нужны следующие строки?
            '(0 . "TEXT")
            (cons 40 (getvar "TEXTSIZE"))
      ) ;_  list
   ) ;_  setq
И далее вот это:
Код:
[Выделить все]
;запрашиваем образец маркера
    (progn (setq obj (car (entsel "\nВыберите образец: ")))
;зачем car?
           (if obj
            (setq obj (entget obj) ;что здесь получаем из obj?
; и далее какой-то танец с лямбдой?
                  l   (mapcar '(lambda (x) (assoc x obj)) '(1 0 7 8 40))
                  obj nil
                  lst (test (cdar l))
            ) ;_  setq
           ) ;_  if
    ) ;_  progn
Все остальное, вроде понятно. Так я и сам скоро что-либо напишу.
А из этого что-либо мне видится следующее.
Сейчас имеется функция test, я бы обозвал ее, все-таки mparse, потому как она выполняет именно разбор выражения. Далее, есть небольшой довесок к ней, который определяет принадлежит ли данное выражение указанной грамматике. Этот довесок можно оформить в виде функции mtest, котороя будет принимать список от mparse и возвращать Т если выражение соответствует грамматике М (маркер). Таким образом применяя эти две функции к множеству всех выражений мы можем получить подмножество всех маркеров в данном чертеже.
И есть, надо только оформить в виде функции, генератор регулярного вражения удовлетворяющего грамматике М, обзавем ее mgen (marker generator).
Но само по себе множество всех маркеров не очень интересно. Хотелось бы иметь функцию mfind, которая была бы способна находить среди множества всех маркеров маркер удовлетворяющий заданному условию. Например, найти все маркеры с прeфиксом R, или BTH. Префикс можно задать списком (R), (К, ВТН, ВТМ) и т.п. Кроме того, можно было бы критерием поиска задать поиск маркеров с заданными префиксом и инфиксом, ну и для полноты можно задать префикс, инфикс и потфикс, что бы найти конкретный маркер.
Возможно задать не полный префикс или инфикс, например (префикс ВТН инфикс 2.*) или (префикс ВТ*)(инфикс 2.*)
Найденные маркеры можно размещать в списке, который будет пуст, если ничего не найдено.
Имея такой список можно довольно легко подсчитать количество вхождений всех маркеров заданного типа, например количество R, C, D.
Там где есть поиск, может быть и замена.
Заменить префикс, заменить инфикс для указанного префикса.
Ну и конечно функция delete.
На основе этого можно создать довольно мощный инструмент для работы с текстовыми данными в чертеже, и областью применения которого могут быть чертежи из разделов СС, автоматизации, ЭО и т.п.
Эх как меня занесло далеко.
Но, вообще, меня интересуют сейчас возможности лисп по обработке контекстно свободных грамматик. Потому как регулярные выражения обладают наименьшей мощностью из всех типов грамматик, хотя и довольно часто применяются на практике. Но для реализации КС-грамматики необходим автомат со стеком. Как, интересно, обстоят дела в лиспе со стеком? Как его тут можно реализовать? Да и автомат как реализовать мне не ясно? Но это уже от недостаточного знания лиспа. Блн, последний абзац надо воспринимать как свободные блуждания в туманной области.
Ну что же. Первый цикл завершен успешно. Приступим к следующему. К реализации намеченных выше функций.
Дополнение.
Для полноты поиска надо еще сделать поиск первого маркера и поиск последнего маркера.
Причем P1.1.5>P1.1.2, P1.3.1>P1.2.100, т.е. при сравнении учитывать инфиксы поразрядно, а потом сравнивать постфикс.
Попробую сконструировать функцию mfind_last. Как всегда m - приставка, означающая функцию для работы с маркерами, find_last - наити последний (с наибольшим номером) маркер
Код:
[Выделить все]
(defun mfind_last ( template / )
;выбрать все текстовые примитивы
  (setq sstxt (ssget "X" '((0 . "TEXT"))))
  ;оставить в наборе только те, которые подходят по template (шблон)
  
  ;упорядочить набор по убыванию
  ;первый элемент в наборе и будет последним (наибольшим) в последовательности
)
Шаблоном может быть выражение, например "DD", "BTH", "BTM1.2.", "BTM2." .
Точка в шаблоне говорит о том что это инфикс а не постфикс.
Тогда функция mfind_last будет выглядеть так
Код:
[Выделить все]
(defun mfind_last ( template / )
  ;выбрать все текстовые примитивы
  (setq mlist (ssget "X" '((0. "TEXT"))))
  ;оставить в списке mlist только маркеры попадающие по шаблон
  (mf template mlist)
  ;упорядочить набор по убыванию
  (mto_order_seq mlist)
  ;первый элемент в наборе и будет последним (наибольшим) в последовательности
)
(defun mf (mlist template / ) ;фильтр для отбора
  ;сформировать отфильтрованный список
  ;здесь как-то применить mparse и mtest для формирования нового отфильтрованного списка
  ;плюс правила отбора
  ;если после префикса в шаблоне * или ничего (пример, DD, DD*), то выбираем все маркеры с данным префиксом
  ;если задан префикс и инфикс (пример BTH-1.*), то поступаем аналогично, но с учетом инфикса. Здесь работает простой текстовый фильтр на основе функции wcmatch.
)
(defun mto_order_seq( mlist / ) ;mlist - список маркеров
  ;упорядочить список маркеров по убыванию
  ;правила для операции >
  ;(= префикс template_prefix) and
  ;(>= infix template_infix) and
  ;(> postfix template_postfix) 
  ;что типа вот так будет выглядеть
  ;(and (and (= префикс template_prefix) (>= infix template_infix) (> postfix template_postfix))) - T
)
Вот такая, приблизительно, конструкция получается.
Далее.
На основе фильтра mf можно создать функцию mcount для подсчета количества элементов по шаблону, например (mcount "DD"), (mcount "BTH"), (mcount "RJ*"), (mcount "BTM1.2.*) - все BTM в первом подъезде на втором этаже или от ЩА2, кто как там обозначает.
Код:
[Выделить все]
(defun mcount (template / )
  ;выбрать все маркеры
  ;отфильтровать их по шаблону
  ;подсчитать количество элементов в списке, это и будет искомое число элементов
)
Везде пишу заготовки или основные конструкции функций. На качественную реализацию не хватает знаний и опыта. Поэтому, плз, помогите, кто чем может.

На основе функции mfind_last можно создать функцию madd.template, которая будет находить последний (с наибольшим номером) элемент и генерировать новый маркер (функция mgen). Тем самым будет гарантировано, что разные элементы имеют разные маркеры.
У функции mgen должен быть параметр
- 0 - не изменять постфикс;
- 1 (или +) - инкремент постфикса;
- 2 (или -) - декремент постфикса.
- по умолчанию действует 1 (или +), т.е. инкремент.

Блоки.
Маркер может быть привязан к атрибуту блока. При вставке блока будет вызываться mgen, генерируя новый маркер.
Ну обработка блоков с маркерами и прочими атрибутами это уже отдельная песня. Ее споем чуть по позже.

Сейчас надо определить функции замены и удаления маркера.
Код:
[Выделить все]
(defun mreplace ( template sample / ) ;заменить шаблон на образец
  ;для каждого найденного маркера произвести замену
  ;пример, BTH поменять на BTM, U-1.2. заменить нa U-2.2
)
(defun msreplace ( "/template/sample/g" )
  ;другая форма функции замены. Параметр задается в виде строки
  ;где / разделитель, g - опция глобальной замены, если она отсутствует
  ; то замена производится только один раз для первого найденного маркера.

)
(defun mdelete (template / )
  ;удалить найденный маркер
)

Последний раз редактировалось Serge_BN, 11.09.2009 в 11:25.
Serge_BN вне форума  
 
Непрочитано 11.09.2009, 12:46
#21
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Практически все, что написано выше достаточно легко реализуется в LISP'е. Просто для начала сильно много информации. Начнем с mfind:
Код:
[Выделить все]
;ищем ВСЕ маркеры, соответствующие нашему синтаксису
(ssget "_X" (list '(0 . "TEXT") (cons 1 "@*#")))
;ищем маркеры, соответствующие нашему синтаксису и начинающиеся на P1.1.
(ssget "_X" (list '(0 . "TEXT") (cons 1 "P1.1.*#")))
Ну и т.д.
С сортировкой не совсем ясно...
Сортируем по убыванию
Код:
[Выделить все]
(vl-sort '("P1.1.5" "P1.1.2" "P1.3.1" "P1.2.100") '<)
;->("P1.1.2" "P1.1.5" "P1.2.100" "P1.3.1")
или надо по другому? Приведи конкретный пример.
CB вне форума  
 
Автор темы   Непрочитано 11.09.2009, 13:34
#22
Serge_BN

инженер
 
Регистрация: 18.04.2007
Оренбург
Сообщений: 71


Код:
[Выделить все]
;ищем ВСЕ маркеры, соответствующие нашему синтаксису
(ssget "_X" (list '(0 . "TEXT") (cons 1 "@*#")))
;ищем маркеры, соответствующие нашему синтаксису и начинающиеся на P1.1.
(ssget "_X" (list '(0 . "TEXT") (cons 1 "P1.1.*#")))
Чудесно, выразительность, мощь и при этом какой-то, что-ли аскетизм этого языка меня поражают, плюс профессионализм. Жаль, что не пришлось познакомиться с ним раньше (с языком, да и с СВ тоже ).

Вот здесь будем поступать как изложено в правилах для функции >.
Тогда вот это
Код:
[Выделить все]
(vl-sort '("P1.1.5" "P1.1.2" "P1.3.1" "P1.2.100") '<)
;->("P1.1.2" "P1.1.5" "P1.2.100" "P1.3.1")
все правильно, только наоборот, первым элементом в списке должен быть "Р1.3.1" он как раз наибольший. Наоборот может быть и не обязательно. Просто мне кажется, что извлечь первый элемент списка проще чем последний, но это уж дело техники.
Примеры. К1.2.100 < К1.3.0, K1.2.100 < K1.2.101, K1.2.100 < K2.1.100
Получается, что вес инфикса тем больше чем левее он записан.
Код:
[Выделить все]
i^n > i^n-1> ...> i^1>i^0
где i - инфикс, n - номер инфикса в выражении нулевой разряд n справа как при арабской записи чисел.

Присмотрелся вот к этому
Код:
[Выделить все]
;ищем ВСЕ маркеры, соответствующие нашему синтаксису
(ssget "_X" (list '(0 . "TEXT") (cons 1 "@*#")))
@*# ищет все тексты начинающиеся с буквы (@), за которой следуют буквы (@*), за которыми следует цифра. А как тогда АА1.А.1? Оно попадет в набор, но не будет являться тем что надо. Мне все-таки кажется, что надо как-то прикрутить именно проверку выражения на соответствие грамматике, инче будет много лишнего в наборе.
И еще, по инфиксам.
1.2.3. - это не один большой инфикс, это, все-таки три разных инфикса 1, 2, 3. Где наибольшим весом обладает 1( первый инфикс), а инфикс 3 обладает наименьшим весом из приведенных 1.2.3.

Последний раз редактировалось Serge_BN, 11.09.2009 в 14:24.
Serge_BN вне форума  
 
Непрочитано 14.09.2009, 11:54
#23
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Цитата:
Присмотрелся вот к этому
Ты абсолютно прав, но все же в набор попадет меньше "мусора"...
Дальше этот набор нужно уточнить на соответствие грамматике, причем именно на этом этапе необходимо определиться как задавать маску выбора. Ведь наверняка придется искать маркеры с конкретным "префиксом" и "инфиксом", чтобы менять "постфикс".
Что касается сортировки, тут все ясно. Где-то на этом форуме мне попадался код, который выложил или VVA или kpblc для корректрой сортировки текста с цифрами. Я попытался ускорить его, но по моему не совсем удачно. Если дадут ссылку на тот лисп, можно его использовать, а пока привожу свой вариант (алгоритм тот же):
Код:
[Выделить все]
(defun SortMaker (lst / count i i1)
 (setq count 0)
 (foreach str lst
  (setq i 0)
  (while (wcmatch (substr str (1+ i)) "*#*")
   (while (wcmatch (substr str (setq i (1+ i)) 1) "~#"))
   (setq i1 i)
   (while (wcmatch (substr str (setq i1 (1+ i1)) 1) "#"))
   (setq count (max count (- i1 i))
         i     i1
   ) ;_  setq
  ) ;_  while
 ) ;_  foreach
 (mapcar
  '(lambda (x) (nth x lst))
  (vl-sort-i
   (mapcar
    '(lambda (str / buf s)
      (setq i   0
            i1  1
            buf ""
      ) ;_  setq
      (while (wcmatch (substr str (1+ i)) "*#*")
       (while (wcmatch (substr str (setq i (1+ i)) 1) "~#"))
       (setq buf (strcat buf (substr str i1 (- i i1)))
             i1  i
       ) ;_  setq
       (while
        (wcmatch (substr str (setq i1 (1+ i1)) 1) "#")
       ) ;_  while
       (setq s (substr str i (- i1 i))
             i i1
       ) ;_  setq
       (while (< (strlen s) count) (setq s (strcat "0" s)))
       (setq buf (strcat buf s))
      ) ;_  while
      (strcat buf (substr str (1+ i)))
     ) ;_  lambda
    lst
   ) ;_  mapcar
   '<
  ) ;_  vl-sort-i
 ) ;_  mapcar
) ;_  defun
;;;(SortMaker '("P-2.1.5" "P-1.1.5" "P-100.2.1" "P-1.1.3" "P-100.1.1" "P-1.1.10" "P-1.1.20" "P-1.5.2" "P-1.6.1"))
-> ("P-1.1.3" "P-1.1.5" "P-1.1.10" "P-1.1.20" "P-1.5.2" "P-1.6.1" "P-2.1.5" "P-100.1.1" "P-100.2.1")
Цитата:
извлечь первый элемент списка проще чем последний
первый элемент (car lst), последний - (last lst)
CB вне форума  
 
Автор темы   Непрочитано 14.09.2009, 15:25
#24
Serge_BN

инженер
 
Регистрация: 18.04.2007
Оренбург
Сообщений: 71


Цитата:
Дальше этот набор нужно уточнить на соответствие грамматике, причем именно на этом этапе необходимо определиться как задавать маску выбора. Ведь наверняка придется искать маркеры с конкретным "префиксом" и "инфиксом", чтобы менять "постфикс".
Надо подумать.
Цитата:
Что касается сортировки, тут все ясно.
Ну насчет сортировки давай уточним. Собственно сортировка вовсе не нужна. Я упомянул сортировку просто потому, что обычно так и делают, если нужно найти первый или последний элемент последовательности.
Но, задача состоит в том чтобы найти первый/последний элемент и для этого не всегда надо делать сортировку.
Рассмотрим несколько подробнее то, среди чего нам надо найти первый/последний элемент.
1. Обзовем эту функцию mfind_last, mfind_first - найти последний, найти первый. Это для того, чтобы было однозначно ясно что мы делаем.
2. Передавать этим функциям будем список строк, где каждая строка имеет вид:
префикс дефис? (инфикс разделитель)* постфикс
Где-то там перед вызовом mfind_last у нас имеется список всех маркеров. Из них надо сделать список маркеров только тех, у которых префикс равен образцу.
Тогда mfind_last фильтрацией маркеров заниматься уже не будет.
И, теперь префикс в сортировке может и не участвовать.
Мы его просто будем игнорировать.
3. Далее идет старший по весу инфикс. Поэтому мы можем отбросить все маркеры, у которых старший по весу инфикс меньше наибольшего в последовательности.
Алгоритм простой. Берем первый в последовательности старший инфикс и сравниваем его со следующим маркером. Если следующий больше текущего, то в качестве образца (текущего) берем его, иначе оставляем текущий. Т.о. мы найдем наибольший старший инфикс.
После чего создадим новый список маркеров, у которых старший инфикс равен наибольшему. Все остальные маркеры рассматривать не имеет смысла.
4. К новому списку применяем п. 3.
5. До тех пор, пока не дойдем до постфикса и к постфиксу применим опять п.3 и в результате получим маркер с наибольшим весом, или последний в последовательности. В результате мы получим список с одним единственным искомым наибольшим элементом.
6. Для mfind_first делает все так же, только ищем наименьший.

Теперь вернемся к первой задаче. Как задавать маску для поиска?
Думаю, что это не сложно. Префикс у нас отвечает за тип маркера (элемента) и задается либо явным указанием префикса DD*, BTH*, BTK* и т.д. либо его можно задать *, тогда программа должна сформировать столько списков маркеров, сколько типов префиксов найдет в чертеже. Соответственно и инфиксы - DD1.*, DD1.2* и т.д до того уровня детализации, который мне необходим, вплодь до DD1.2.7 - конкретный маркер.
Программа должна находить все, что попадает в шаблон и возвращать упорядоченный по возрастанию список маркеров.
Собственно в работе все это не очень-то и нужно. Данная задача возникает из необходимости иметь непрерывные последовательности маркеров. А в работе возникают ситуации, когда в последовательности маркера имеются дыры либо дубликаты. Эти случаи необходимо распознавать и приводить к упорядоченной непрерывной последовательности. Под непрерывной последовательностью я понимаю такую последовательность маркеров, которая пронумерована без дыр и дубликатов с шагом 1.
Может возникнуть задача объединить несколько наборов маркеров в одну последовательность. например, DD1.2* DD2.1 в последовательность DD1.0.*. Но сдесь так же можно задать список последовательностей и список содержащий целевой маркер. (src1 src2)(dst).
Serge_BN вне форума  
 
Непрочитано 14.09.2009, 16:18
#25
CB

Конструирование в области нефтеразведки
 
Регистрация: 10.02.2006
Гомель
Сообщений: 321


Да это все все ясно, не понято что делать в таком случае:
Пусть на чертеже есть маркеры P-1.1 P-1.5 и P-1.1.7
1. Маска поиска - P-1.*#
2. Все три маркера попали в набор
3. С первыми двумя понятно - P-1.5 маркер с наибольшим весом
Вопрос - что делать с третьим, ведь это маркер совершенно другого типа???
CB вне форума  
 
Автор темы   Непрочитано 15.09.2009, 09:14
#26
Serge_BN

инженер
 
Регистрация: 18.04.2007
Оренбург
Сообщений: 71


Цитата:
Вопрос - что делать с третьим, ведь это маркер совершенно другого типа???
Вопрос хороший. И на него есть такой же хороший ответ.
1. Обычно с схемах автоматизации, СС, СКС таких ситуаций не встречается. Не встречается потому, что маркировкой управляет инженер-конструктор и он прекрасно соображает, что если устройства будут промаркированы таким образом, то будут весьма плачевные последствия.
2. Если же, все-таки такая ситуация встретилась.
Можно делать отсев по количеству инфиксов, т.е. Р-1.2, Р-1.1.2 и Р-1.1.1.2 это будут разные маркеры и они не должны попасть в один набор. А маску для отбора можно будет задавать так Р?1.#+., где Р- это префикс, ? - возможный символ дефиса из набора '-','.',' ','', 1 - значение старшего инфикса, . - разделитель, #+ -инфикс, любое количество непрерывных цифр, . - разделитель. Вот последний разделитель как раз и скажет что надо производить отбор только тех маркеров, у которых только два инфикса.
Другой пример. Р-#+.#+. это почти тоже, что и предыдущий маркер, только в наборе будут присутствовать маркеры с любым старшим инфиксом.
Если же убрать последнюю точку, то в набор попадут какие попало маркеры Р-1.2, Р-1.2.3.4.100 и все что угодно с любым хвостом. Поэтому и присутствуют в маркере синтаксические конструкции - разделитель и инфикс. Для того, что бы каждый раз знать, что вот здесь закончился инфикс, или, другими словами, это самый младший инфикс, за которым следует постфикс. Это и есть решение данной проблемы. Реализация может быть разной, например, фильтр по количеству инфиксов. Может встретиться маркер типа D1, D2, т.е. в нем отсутствует инфикс. Его шаблон может быть D#+ без точек, это значит префикс за которым непосредственно следует постфикс. В конструкции P-1.2.#+ символы #+ означают тоже постфикс, который есть целое число.
Примечание. Везде, где я пишу #+, подразумевается # это цифра (0|1|2|3|4|5|6|7|8|9), + говорит о том что цифр может хотя бы одна и более.
* - говорит о том, что в контексте #* цифр может и не быть, либо быть сколько угодно. Хотя сама по себе * означает вообще все что угодно.
В доказательсто того, что это будет работать можно было бы вывести несколько теорем о свойствах маркеров такого типа, но я думаю, что приведенных рассуждений достаточно. Хотя, можно подумать и над математикой в смысле вывода свойств маркеров, формулировки и доказательству теорем и т.д. Тем более, если еще вспомнить, что программирование это в первую очередь математика а потом уже кодирование.

Последний раз редактировалось Serge_BN, 15.09.2009 в 09:24.
Serge_BN вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Как создать маркер c использованием acadЛИСП?



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как в Акад 2006 программно создать подшивку с заданным набор kp+ Программирование 4 16.03.2009 23:23
Как создать функцию с необязательным вводом параметра Krieger Программирование 2 14.02.2009 11:49
SW подскажите как создать радиальное отверстие Chives SolidWorks 23 17.12.2008 00:54
Как создать виртуальный принтер Владислав Кулигин Компьютерная и бытовая техника, электроника и инструмент 4 03.01.2008 17:54
Юмор 2007 Огурец Разное 1172 29.12.2007 11:16