[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]

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

[VVA]

Если #2 не устраивает и точки по каким-либо причинам должны остаться, то, как вариант, можно их перенести на блокированный слой, т.к. в команде идет выбор примитивов типа "точка" (point) на незаблокированных слоях (ключ "_:L" в функции ssget)

Код:

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

 (setq objSet(ssget "_:L" '((0 . "POINT"))))

----- добавлено через ~3 мин. -----
Нашел тему на caduser'e Перенос из содержания текста в координату z рядом стоящей точки

[kp+]

Сообщение от mansur_09 точки которые остались без своих высотных отметках

Как определить, что они действительно остались без отметок? чертеж в студию!

Сообщение от Кулик Алексей aka kpblc А не проще будет такие точки удалять вручную вместе с текстами?

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

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

Нашел тему на caduser'e Перенос из содержания текста в координату z рядом стоящей точки

Это та же самая программа или нет?

[mansur_09]

Сообщение от kp+ Поэтому нужно отсеять те точки, которые "выделяются из коллектива".

Да, kp+, это и нужно.
Отсюда вопрос: как сделать так, чтобы выдавался запрос на задание максимальной дистанции между текстом и точкой. а не присваивалось значение ближайшего текста.
Приложил файл (Autocad 2007). Коричневым цветом выделены неправильные высотные отметки.

[kp+]

Точки которые остались <без> своего текста, "ловят" ближайшие отметки.

Я думал, что возле некоторых точек ВООБЩЕ НЕТ текста отметки, а он везде есть.

Сообщение от mansur_09 Коричневым цветом выделены неправильные высотные отметки.

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

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

[mansur_09]

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

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

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

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

[dima_25]

VVA, здравствуйте! Можно переделать ztxt.lsp, чтобы переносить координату Z не на точку, а на блок (его базовую точку). В моем случае почти всегда геодезическая съемка, что касается отметок поверхности земли, выглядит как блок и текст, а не точка и текст. Или проще воспользоваться сначала frto.lsp?

[VVA]

dima_25, Глянул код, вроде можно. Выложи dwg c примером блока.

[dima_25]

VVA, выкладываю. Autocad 2014

[VVA]

Тестируй. Команда 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")

[dima_25]

VVA, из командной строки:
Команда: _appload ZtxtB.lsp успешно загружено.
Команда: ; ошибка: синтаксическая ошибка

[VVA]

не полностью скопировал код из #11. Пробуй еще раз. На всякий случай прикрепил еще lsp файл

[АлексЮстасу]

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

Можно ли изменить этот лисп так, чтобы значение текста становилось значением атрибута ближайшего блока? Не в Z блока передавать значение текста, а в атрибут.
Т.е. уже должен существовать блок с атрибутом, рядом с ним надписаны тексты (номера объектов или названия или т.п.).

[VVA]

Сразу вопросы:
- какой блок считать ближайшим? (Точка вставки, середина габаритного контейнера)
- текст - это однострочный текст, многострочный или оба?
- для текста - какую точку брать для сравнения?
Ну и примерчик в виде dwg файла был бы не лишним

[АлексЮстасу]

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

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

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

Пример пока фантазийный.