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

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Помогите скоретировать lisp ztxt

Помогите скоретировать lisp ztxt

Версия для печати
 
Ответ
Опции темы Поиск в этой теме
Непрочитано 12.01.2015, 14:26 #1
Помогите скоретировать lisp ztxt
mansur_09
 
Регистрация: 03.01.2014
Сообщений: 27

mansur_09 вне форума Вставить имя

Добрый день форумчане.
проблема такая.
Есть полезный лисп ZTXT, код которого приведу ниже. Он поднимает точки от нуля,до уровня который указан в тексте ближе всего находящемся.
моя проблема в том, что есть некорректные высотные отметки (текст) которые и можно удалить, НО при вводе команды лиспа ztxt, точки которые остались своего текста, "ловят" ближайшие отметки.
Помогите переделать лисп так, чтобы точки которые остались без своих высотных отметках не присваивали ближайший текст с высотной отметкой, а оставались на нуле.

сам код ztxt

Код:
[Выделить все]
 (defun C:Ztxt ( / objSet Point ptLst tmp1 tmp2 pat txtZList dst *error*)
;;;http://www.caduser.ru/cgi-bin/f1/board.cgi?t=44709Oh
;;;Перенос из содержания текста в координату z рядом стоящей точки
;;;Координатой Z выбранной точки считается БЛИЖАЙШИЙ текст

(vl-load-com)
(defun *error*(msg)(princ msg)
(vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))(princ))
(vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))  
(if (and
      (setq objSet(ssget "_:L" '((0 . "POINT"))))
      (setq Point (vl-remove-if 'listp(mapcar 'cadr(ssnamex objSet))))
      (setq ptLst(mapcar 'cdr (mapcar '(lambda(x)(assoc 10 x))(mapcar 'entget Point))))
      (setq objSet nil objSet(ssget "_X" (list '(0 . "*TEXT")(cons 410 (getvar "CTAB")))))
      )
  (progn
    (setq tmp1 (vl-remove-if 'listp(mapcar 'cadr(ssnamex objSet))))
    (setq tmp1 (mapcar '(lambda(x)(setq x (entget x))(list (cdr(assoc 10 x))(cdr(assoc 1 x)))) tmp1))
    (foreach pt ptlst
      (setq tmp2 (mapcar '(lambda(x)(list (distance pt (car x))(cadr x))) tmp1))
      (setq pat (car tmp2))
      (foreach dst tmp2 (if (< (car dst) (car pat))(setq pat dst)))
      (setq txtZList (cons (cadr pat) txtZList))
      )
    (setq txtZList (reverse txtZList))
    (setq txtZList (mapcar '(lambda(x)
                    (vl-string-translate "," "." (vl-string-trim  "%UuoOcC \t"   x))
                   )txtZList))
    (mapcar '(lambda(ptObj pt Z)
               (vla-put-coordinates (vlax-ename->vla-object ptObj)
                (vlax-3d-point (list (car pt)(cadr pt) Z))  
               )
               )
           Point ptLst (mapcar 'atof txtZList)
            )
    )
  )
  (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
  (princ)
  )
(princ "\nType Ztxt in command line")

Последний раз редактировалось Кулик Алексей aka kpblc, 12.01.2015 в 14:53. Причина: лексикс
Просмотров: 4258
 
Непрочитано 12.01.2015, 14:54
#2
Кулик Алексей aka kpblc
Moderator

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


А не проще будет такие точки удалять вручную вместе с текстами?
__________________

---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 12.01.2015, 21:57
#3
VVA

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


Если #2 не устраивает и точки по каким-либо причинам должны остаться, то, как вариант, можно их перенести на блокированный слой, т.к. в команде идет выбор примитивов типа "точка" (point) на незаблокированных слоях (ключ "_:L" в функции ssget)
Код:
[Выделить все]
 (setq objSet(ssget "_:L" '((0 . "POINT"))))
----- добавлено через ~3 мин. -----
Нашел тему на caduser'e Перенос из содержания текста в координату z рядом стоящей точки
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 12.01.2015, 23:42
#4
kp+

идущий по граблям
 
Регистрация: 26.05.2005
Днепропетровск
Сообщений: 3,572


Цитата:
Сообщение от mansur_09 Посмотреть сообщение
точки которые остались без своих высотных отметках
Как определить, что они действительно остались без отметок? чертеж в студию!

Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
А не проще будет такие точки удалять вручную вместе с текстами?
Конечно, проще. Но это же надо сделать вручную
Подозреваю, что дело в строке 22, где каждая точка поднимается на высоту, соответствующую ближайшей отметке, даже если расстояние от "нормальных" точек до "их" текстов не превышает 5 мм, а от "обделенной" точки до ближайшего к ней текста - 15 мм. Цифры, разумеется, условные.

Поэтому нужно отсеять те точки, которые "выделяются из коллектива". В качестве критерия можно использовать половину средней ширины текста отметки. Точнее можно сказать, увидев чертеж. Могут быть нюансы, связанные с плотностью заполнения, видом выравнивания текстов и регулярностью их расположения относительно "своих" точек (единообразно или как попало).

Цитата:
Нашел тему на caduser'e Перенос из содержания текста в координату z рядом стоящей точки
Это та же самая программа или нет?
__________________
Кому жизнь буги-вуги, а кому полный бред... (С)
kp+ вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 13.01.2015, 07:49
#5
mansur_09


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


Цитата:
Сообщение от kp+ Посмотреть сообщение
Поэтому нужно отсеять те точки, которые "выделяются из коллектива".
Да, kp+, это и нужно.
Отсюда вопрос: как сделать так, чтобы выдавался запрос на задание максимальной дистанции между текстом и точкой. а не присваивалось значение ближайшего текста.
Приложил файл (Autocad 2007). Коричневым цветом выделены неправильные высотные отметки.
Вложения
Тип файла: dwg
DWG 2007
Drawing1.dwg (2.77 Мб, 1050 просмотров)
mansur_09 вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 13.01.2015, 10:18
#6
kp+

идущий по граблям
 
Регистрация: 26.05.2005
Днепропетровск
Сообщений: 3,572


Цитата:
Точки которые остались <без> своего текста, "ловят" ближайшие отметки.
Я думал, что возле некоторых точек ВООБЩЕ НЕТ текста отметки, а он везде есть.

Цитата:
Сообщение от mansur_09 Посмотреть сообщение
Коричневым цветом выделены неправильные высотные отметки.
Как понять, что они неправильные? Сильно отличаются от среднего значения или есть другие критерии? Или это только Вы знаете? Если так, то рулит совет из #3, и переделывать код не нужно.

PS
Единообразность оформления наводит на мысли о музыке джаз том, что инфа в чертеж экспортирована из некоего программного комплекса/файла данных. Не лучше ли найти исходник? На форуме полно лиспов для выноса табличных даных в точки на чертеже с адекватной установкой отметки.
__________________
Кому жизнь буги-вуги, а кому полный бред... (С)

Последний раз редактировалось kp+, 13.01.2015 в 10:42.
kp+ вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Автор темы   Непрочитано 13.01.2015, 11:12
#7
mansur_09


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


Цитата:
Сообщение от kp+ Посмотреть сообщение
Цитата:
Точки которые остались <без> своего текста, "ловят" ближайшие отметки.
Я думал, что возле некоторых точек ВООБЩЕ НЕТ текста отметки, а он везде есть.
Текст выделенный корчневым цветом неправильный, потому что как вы сказали отличается от средних значений. быть может какой-то баг, не знаю. в воложенном файле я их просто не удалил.
да, действительно инфа была экспортирована из какого-то программного комплекса. Я этого не знаю из какого. и исходника тоже нет.
в выложенном файле часть данных. всего точек и текстов еще в 20 раз больше.
Цитата:
Сообщение от kp+ Посмотреть сообщение
Подозреваю, что дело в строке 22, где каждая точка поднимается на высоту, соответствующую ближайшей отметке, даже если расстояние от "нормальных" точек до "их" текстов не превышает 5 мм, а от "обделенной" точки до ближайшего к ней текста - 15 мм. Цифры, разумеется, условные.

Поэтому нужно отсеять те точки, которые "выделяются из коллектива". В качестве критерия можно использовать половину средней ширины текста отметки.
Как это реализовать? так чтобы, точки присваивали значение не ближайшего текста, а допустим текткста находящемся на расстоянии 1м
mansur_09 вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 10.06.2016, 00:19
#8
dima_25


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


VVA, здравствуйте! Можно переделать ztxt.lsp, чтобы переносить координату Z не на точку, а на блок (его базовую точку). В моем случае почти всегда геодезическая съемка, что касается отметок поверхности земли, выглядит как блок и текст, а не точка и текст. Или проще воспользоваться сначала frto.lsp?
dima_25 вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 10.06.2016, 17:28
#9
VVA

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


dima_25, Глянул код, вроде можно. Выложи dwg c примером блока.
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 10.06.2016, 17:36
#10
dima_25


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


VVA, выкладываю. Autocad 2014
Вложения
Тип файла: dwg
DWG 2013
съемка отметки.dwg (460.1 Кб, 16 просмотров)
dima_25 вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 10.06.2016, 20:10
#11
VVA

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


Тестируй. Команда ZtxtB
Код:
[Выделить все]
 
(defun C:Ztxt ( / objSet Point ptLst tmp1 tmp2 pat txtZList dst *error*)
;;;http://www.caduser.ru/forum/index.php?PAGE_NAME=message&FID=23&TID=44766&MID=250189#message250189
;;; http://forum.dwg.ru/showthread.php?t=118394
;;; http://forum.dwg.ru/showthread.php?p=1541786#post1541786  
;;;Перенос из содержания текста в координату z рядом стоящей точки
;;;Координатой Z выбранной точки считается БЛИЖАЙШИЙ текст

(vl-load-com)
(defun *error*(msg)(princ msg)
(vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))(princ))
(vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))  
(if (and
      (setq objSet(ssget "_:L" '((0 . "POINT"))))
      (setq Point (vl-remove-if 'listp(mapcar 'cadr(ssnamex objSet))))
      (setq ptLst(mapcar 'cdr (mapcar '(lambda(x)(assoc 10 x))(mapcar 'entget Point))))
      (setq objSet nil objSet(ssget "_X" (list '(0 . "*TEXT")(cons 410 (getvar "CTAB")))))
      )
  (progn
    (setq tmp1 (vl-remove-if 'listp(mapcar 'cadr(ssnamex objSet))))
    (setq tmp1 (mapcar '(lambda(x)(setq x (entget x))(list (cdr(assoc 10 x))(cdr(assoc 1 x)))) tmp1))
    (foreach pt ptlst
      (setq tmp2 (mapcar '(lambda(x)(list (distance pt (car x))(cadr x))) tmp1))
      (setq pat (car tmp2))
      (foreach dst tmp2 (if (< (car dst) (car pat))(setq pat dst)))
      (setq txtZList (cons (cadr pat) txtZList))
      )
    (setq txtZList (reverse txtZList))
    (setq txtZList (mapcar '(lambda(x)
                    (vl-string-translate "," "." (vl-string-trim  "%UuoOcC \t"   x))
                   )txtZList))
    (mapcar '(lambda(ptObj pt Z)
               (vla-put-coordinates (vlax-ename->vla-object ptObj)
                (vlax-3d-point (list (car pt)(cadr pt) Z))  
               )
               )
           Point ptLst (mapcar 'atof txtZList)
            )
    )
  )
  (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
  (princ)
  )
  (defun C:ZtxtB ( / objSet Point ptLst tmp1 tmp2 pat txtZList dst *error* mydcl)
;;;http://www.caduser.ru/forum/index.php?PAGE_NAME=message&FID=23&TID=44766&MID=250189#message250189
;;; http://forum.dwg.ru/showthread.php?t=118394
;;; http://forum.dwg.ru/showthread.php?p=1541786#post1541786  
;;;Перенос из содержания текста в координату z рядом стоящей точки
;;;Координатой Z выбранной точки считается БЛИЖАЙШИЙ текст
(defun mydcl (zagl info-list / fl ret dcl_id)
      (vl-load-com)
      (if (null zagl)
        (setq zagl "Выбор")
      ) ;_ end of if
      (setq fl (vl-filename-mktemp "mip" nil ".dcl"))
      (setq ret (open fl "w"))
      (mapcar
        '(lambda (x) (write-line x ret))
        (list "mip_msg : dialog { "
              (strcat "label=\"" zagl "\";")
              " :list_box {"
              "alignment=top ;"
              "width=51 ;"
              "allow_accept = true;"
              "tabs = \"16 32\";"
              "tab_truncate = true;"
              (if (> (length info-list) 26)
                "height= 26 ;"
                (strcat "height= " (itoa (+ 3 (length info-list))) ";")
              ) ;_ end of if
              "is_tab_stop = false ;"
              "key = \"info\";}"
              "ok_cancel;}"
        ) ;_ end of list
      ) ;_ end of mapcar
      (setq ret (close ret))
      (if (and (not (minusp (setq dcl_id (load_dialog fl))))
               (new_dialog "mip_msg" dcl_id)
          ) ;_ end of and
        (progn
          (start_list "info")
          (mapcar 'add_list info-list)
          (end_list)
          (set_tile "info" "0")
          (setq ret (car info-list))
          (action_tile
            "info"
            "(setq ret (nth (atoi $value) info-list))"
          ) ;_ end of action_tile
          (action_tile
            "cancel"
            "(progn(setq ret nil)(done_dialog 0))"
          ) ;_ end of action_tile
          (action_tile "accept" "(done_dialog 1)")
          (start_dialog)
        ) ;_ end of progn
      ) ;_ end of if
  
      (unload_dialog dcl_id)
      (vl-file-delete fl)
      ret
    )
(vl-load-com)
(defun *error*(msg)(princ msg)
(vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))(princ))
(vla-StartUndoMark (vla-get-activedocument (vlax-get-acad-object)))
(while (setq tmp1 (tblnext "BLOCK" (null tmp1)))
        (setq ptLst (cons (cdr (assoc 2 tmp1)) ptLst))
      )
(setq ptlst (vl-remove-if-not 'snvalid ptlst))
(if (and
      ptLst
      (setq tmp1 (mydcl "Select block" (acad_strlsort ptlst)))
      (setq objSet(ssget "_:L" (list(cons 0 "INSERT")(cons 2 tmp1))))
      (setq Point (vl-remove-if 'listp(mapcar 'cadr(ssnamex objSet))))
      (setq ptLst(mapcar 'cdr (mapcar '(lambda(x)(assoc 10 x))(mapcar 'entget Point))))
      (setq ptLst (mapcar '(lambda(x)(list (car x)(cadr x) 0.0))ptLst))
      (setq objSet nil objSet(ssget "_X" (list '(0 . "*TEXT")(cons 410 (getvar "CTAB")))))
      )
  (progn
    (setq tmp1 (vl-remove-if 'listp(mapcar 'cadr(ssnamex objSet))))
    (setq tmp1 (mapcar '(lambda(x)(setq x (entget x))(list(list (car(cdr(assoc 10 x)))(cadr(cdr(assoc 10 x))))(cdr(assoc 1 x)))) tmp1))
    (foreach pt ptlst
      (setq tmp2 (mapcar '(lambda(x)(list (distance pt (car x))(cadr x))) tmp1))
      (setq pat (car tmp2))
      (foreach dst tmp2 (if (< (car dst) (car pat))(setq pat dst)))
      (setq txtZList (cons (cadr pat) txtZList))
      )
    (setq txtZList (reverse txtZList))
    (setq txtZList (mapcar '(lambda(x)
                    (vl-string-translate "," "." (vl-string-trim  "%UuoOcC \t"   x))
                   )txtZList))
    (mapcar '(lambda(ptObj pt Z)
               (vla-put-InsertionPoint (vlax-ename->vla-object ptObj)
                (vlax-3d-point (list (car pt)(cadr pt) Z))  
               )
               )
           Point ptLst (mapcar 'atof txtZList)
            )
    )
  )
  (vla-EndUndoMark (vla-get-activedocument (vlax-get-acad-object)))
  (princ)
  )
(princ "\nType Ztxt or ZtxtB in command line")
Вложения
Тип файла: lsp ztxtb.LSP (5.9 Кб, 48 просмотров)
__________________
Как использовать код на Лиспе читаем здесь

Последний раз редактировалось VVA, 13.06.2016 в 15:52.
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 12.06.2016, 13:49
#12
dima_25


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


VVA, из командной строки:
Команда: _appload ZtxtB.lsp успешно загружено.
Команда: ; ошибка: синтаксическая ошибка
dima_25 вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 13.06.2016, 15:51
#13
VVA

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


не полностью скопировал код из #11. Пробуй еще раз. На всякий случай прикрепил еще lsp файл
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 30.10.2017, 20:35
#14
АлексЮстасу

топограф, технолог
 
Регистрация: 24.05.2009
Москва
Сообщений: 2,551


Дабы не плодить темы - название темы подходит, и лисп сам по себе удачный.

Можно ли изменить этот лисп так, чтобы значение текста становилось значением атрибута ближайшего блока? Не в Z блока передавать значение текста, а в атрибут.
Т.е. уже должен существовать блок с атрибутом, рядом с ним надписаны тексты (номера объектов или названия или т.п.).
__________________
количество моих сообщений не говорит о знании Автокада
АлексЮстасу вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 31.10.2017, 08:52
#15
VVA

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


Сразу вопросы:
- какой блок считать ближайшим? (Точка вставки, середина габаритного контейнера)
- текст - это однострочный текст, многострочный или оба?
- для текста - какую точку брать для сравнения?
Ну и примерчик в виде dwg файла был бы не лишним
__________________
Как использовать код на Лиспе читаем здесь
VVA вне форума вставить имя Обратить внимание модератора на это сообщение  
 
Непрочитано 31.10.2017, 20:24
#16
АлексЮстасу

топограф, технолог
 
Регистрация: 24.05.2009
Москва
Сообщений: 2,551


Я, как всегда, думал, что обойдется малой кровью.
Кстати, сравнил короткую Ztxt с Вашей ZtxtB - Ваша разбирает тексты по блокам лучше.
Недостаток - нет ограничения на радиус поиска. И не отбрасываются уже обработанные тексты-блоки.

Ближайший блок - лучше, похоже, брать середину габаритного контейнера. Без учета атрибутов, если они у блока есть. Если это морочно, то проще брать точку вставки.
Текст - лучше оба, и однострочный и многострочный. Если атрибут однострочный, то из мтекстов брать первую строку.
Точка текста - лучше бы тоже середину габаритного контейнера. Если морочно, то точку вставки.
В целом же Ваше решение из ZtxtB вполне удачное - если "по-быстрому", то можно использовать все как есть.

Главное, что думал добавить - выбор атрибута, если у блока их несколько. И встроить допуск для поиска - допустим, 10 габаритов блока. Или 0.5-1.0 габарита текста.
Но нормально с допуском будет работать, если учитывать не точку вставки текстов, а центры их габаритов.

Пример пока фантазийный.
Вложения
Тип файла: dwg
DWG 2004
ZtxtB_test_attr.dwg (325.3 Кб, 2 просмотров)
__________________
количество моих сообщений не говорит о знании Автокада
АлексЮстасу вне форума вставить имя Обратить внимание модератора на это сообщение  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Помогите скоретировать lisp ztxt

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

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

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

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Lisp, помогите с алгоритмом "подтягивания" поллиний 2123 LISP 1 03.02.2010 23:58
Запуск Lisp команды в новом документе BlackHarp LISP 1 26.03.2009 23:06
Auto Lisp. Помогите с легкой программой. BARS_1985 LISP 6 27.09.2007 11:10
LISP помогите разобраться. Elenaka LISP 5 20.10.2006 18:15
Помогите отладить lisp программу Мишаня LISP 7 31.07.2006 12:54

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