Несколько слов об ошибках в Geo_Tools

Здесь что то вроде FAQ пополам с особенностями geo_tools.

  1. Patron

    Patron Бронебойный Старожил Форумчанин

    Собственно, уже который день ковыряюсь в алгоритмах geo_tools.

    И вот откопал суть своей проблемы, а именно:
    При вводе объекта ТЕКСТ программа не распознает знак "-", стоящий перед текстом
    соответственно, получаются положительные отметки вместо отрицательных

    Прошу помощи!



    Привожу алгоритм "распознавалки", которая отвечает за это в geo_tools


    Раскрыть Спойлер
    (defun edit_text_clean_for_number (text_str / text_obj text_list new_text_list n simvol);clean_text_for_number
    (setq text_list (vl-string->list text_str))
    (setq n 0)
    (repeat (length text_list)
    (setq simvol (nth n text_list))
    (cond
    ((wcmatch (chr simvol) "#")
    (setq new_text_list (append new_text_list(list simvol))))
    ((wcmatch (chr simvol) "@")
    )
    ((wcmatch (chr simvol) "`.")
    (if (/= n 0)
    (if (and (/= (1+ n) (length text_list))(wcmatch (chr (nth (1- n) text_list)) "#")(wcmatch (chr (nth (1+ n) text_list)) "#"))
    (setq new_text_list (append new_text_list(list simvol)))
    )
    )
    )
    ((wcmatch (chr simvol) "`,")
    (if (/= n 0)
    (if (and (/= (1+ n) (length text_list))(wcmatch (chr (nth (1- n) text_list)) "#")(wcmatch (chr (nth (1+ n) text_list)) "#"))
    (setq new_text_list (append new_text_list(list (ascii "."))))
    )
    )
    )
    )
    (setq n (1+ n))
    )
    (vl-list->string new_text_list)
    )


    И оригинал файликов-функции в порядке их отсыла друг к другу
    от get_easy_elevation к edit_text_clean_for_number
     

    Вложения:

  2. Patron

    Patron Бронебойный Старожил Форумчанин

    Прикол в том, что это же как-то реализовано в ztxt! И работает!
    ::apstenu::
    Раскрыть Спойлер
    (defun C:Ztxt ( / objSet Point ptLst tmp1 tmp2 pat txtZList dst *error*)
    (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")
     

    Вложения:

    • ztxt.lsp
      Размер файла:
      1,6 КБ
      Просмотров:
      25
  3. Patron

    Patron Бронебойный Старожил Форумчанин

  4. Alexandr-GR

    Alexandr-GR Форумчанин

    В функции edit_text_clean_for_number нет проверки на знак.. Вставь после (Cond
    Код:
    ((and (= n 0) (wcmatch (chr simvol) "-"))
      (setq new_text_list (append new_text_list (list simvol)))
    )
    но за саму функцию не ручаюсь ::smile24.gif::
     
    -=13=- и Patron нравится это.
  5. Patron

    Patron Бронебойный Старожил Форумчанин

    Alexandr-GR, ЧЕЛОВЕЧИЩЕ!!::good1::
    Спасибо! Заработало! Всё как надо! ::hi::
     
  6. monolit

    monolit Форумчанин

    у меня такой вопрос, можно ли написать лисп под данный скрин
    [​IMG]
    чтоб он был также функционален как и Vektor 2d
    [​IMG]
    пожелания :
    1) [Н][В] должны быть в блоке
    2) разделительная черта должна начинаться от проектного положения конструкции
     

    Вложения:

    • 2.png
      2.png
      Размер файла:
      1,8 КБ
      Просмотров:
      37
    • 1.png
      1.png
      Размер файла:
      2,8 КБ
      Просмотров:
      31
  7. Patron

    Patron Бронебойный Старожил Форумчанин

    Пожалуй, дополню. Исходный лисп примерно такой (там ещё введена функция ввода допустимых значений):


    Раскрыть Спойлер
    (defun c:vktr2d ()
    (setvar "angdir" 0)
    (setq prov (tblsearch "BLOCK" "STRELA"))
    (if (= prov nil)
    (progn
    (command "_layer" "_m" "0" "")
    (command "_color" "_byblock")
    (command "_zoom" "_a")
    (command "_pline" "_non" "0.5,-0.1" "_w"
    "0.0" "0.0" "_non" "3.0,-0.1"
    "_non" "2.7,-0.4" "_non" "5.0,0.0"
    "_non" "2.7,0.4" "_non" "3.0,0.1"
    "_non" "0.5,0.1" "_c" ""
    )
    (setq strlk (entlast))
    (command "_color" "_bylayer")
    (command "_block" "strela" "_non" "0,0,0" strlk "")
    )
    )
    (setq prov (tblsearch "BLOCK" "krug"))
    (if (= prov nil)
    (progn
    (command "_layer" "_m" "0" "")
    (command "_color" "_byblock")
    (command "_zoom" "_a")
    (command "_circle" "_non" "0.5,0.0" ".3")
    (setq strlk (entlast))
    (command "_color" "_bylayer")
    (command "_block" "krug" "_non" "0,0,0" strlk "")
    )
    )

    (command "_layer" "_m" "vektor2d" "")
    (setq mb (getreal "\n Масштаб печати : "))
    (setq d1 (/ 1.5 mb))
    (setq -d1 (- 0.0 d1))
    (setq d2 (/ 7.0 mb))
    (setq -d2 (- 0.0 d2))
    (setq mbstr (/ 1.0 mb))
    (setq mbtxt (/ 2.0 mb))
    (setq dopusk 1000)
    ;(setq dopusk (getreal "\n Допустимое отклонение конструкции в мм: "))
    (setq kod (getstring "\n Направление векторов X или Y : "))
    (setq kod (strcase kod))
    (setq rad (/ 0.33 mb))



    ;
    (while t
    (setq p1 (getpoint "\n Измеренная точка 1")
    p2 (getpoint "\n Измеренная точка 2")
    )
    (if (< (last p2) (last p1))
    (progn (setq ps p1
    p1 p2
    p2 ps
    )
    )
    )
    (setq p3 (getpoint "\n Проектная точка"))

    (setq p4 (getpoint "\n Сторона отрисовки вектора"))

    (setq dp1 (mapcar '- p1 p3)
    dp2 (mapcar '- p2 p3)
    dnpr (mapcar '- p4 p3)
    pp3 (list (car p3) (cadr p3))
    )

    (setq k 1)
    (repeat 2
    (if (/= kod "Y")
    (progn
    (setq xnpr (car dnpr)
    rottxt "0"
    )

    (cond
    ((= k 1)
    (command "_color" "_g")
    (setq dx (car dp1))
    (cond
    ((>= xnpr 0)
    (setq ptst (mapcar '+ pp3 (list d2 -d1))
    tipvst "_ml"
    )

    (cond
    ((>= dx 0) (setq pstr (mapcar '+ pp3 (list d1 -d1))))
    ((< dx 0) (setq pstr ptst))
    )
    )

    ((< xnpr 0)
    (setq ptst (mapcar '+ pp3 (list -d2 -d1))
    tipvst "_mr"
    )

    (cond
    ((< dx 0) (setq pstr (mapcar '+ pp3 (list -d1 -d1))))
    ((>= dx 0) (setq pstr ptst))
    )
    )
    )
    )

    ((= k 2)
    (command "_color" "_b")
    (setq dx (car dp2))
    (cond
    ((>= xnpr 0)
    (setq ptst (mapcar '+ pp3 (list d2 d1))
    tipvst "_ml"
    )

    (cond
    ((>= dx 0) (setq pstr (mapcar '+ pp3 (list d1 d1))))
    ((< dx 0) (setq pstr ptst))
    )
    )

    ((< xnpr 0)
    (setq ptst (mapcar '+ pp3 (list -d2 d1))
    tipvst "_mr"
    )

    (cond
    ((< dx 0) (setq pstr (mapcar '+ pp3 (list -d1 d1))))
    ((>= dx 0) (setq pstr ptst))
    )
    )
    )
    )
    )

    (setq txt (rtos (* (abs dx) 1000) 2 0))
    (if (= k 1) (setq txt (strcat "Н" txt)) (setq txt (strcat "В" txt)))
    (cond ((>= dx 0) (setq rotstr "0"))
    ((< dx 0) (setq rotstr "180"))
    )

    (command "_insert" "strela" "_non" pstr mbstr mbstr rotstr)
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;(if (= k 2)

    ; (command "_insert" "krug" "_non" pstr mbstr mbstr rotstr))

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    (if (> (* (abs dx) 1000) dopusk)
    (command "_color" "_r")
    )
    (command "_text" "_j" tipvst "_non" ptst mbtxt rottxt txt)
    )
    )

    (if (/= kod "X")
    (progn
    (setq ynpr (cadr dnpr)
    rottxt "90"
    )

    (cond
    ((= k 1)
    (command "_color" "_g")
    (setq dy (cadr dp1))

    (cond
    ((>= ynpr 0)
    (setq ptst (mapcar '+ pp3 (list d1 d2))
    tipvst "_ml"
    )

    (cond
    ((>= dy 0) (setq pstr (mapcar '+ pp3 (list d1 d1))))
    ((< dy 0) (setq pstr ptst))
    )
    )

    ((< ynpr 0)
    (setq ptst (mapcar '+ pp3 (list d1 -d2))
    tipvst "_mr"
    )

    (cond
    ((< dy 0) (setq pstr (mapcar '+ pp3 (list d1 -d1))))
    ((>= dy 0) (setq pstr ptst))
    )
    )
    )
    )

    ((= k 2)
    (command "_color" "_b")
    (setq dy (cadr dp2))
    (cond
    ((>= ynpr 0)
    (setq ptst (mapcar '+ pp3 (list -d1 d2))
    tipvst "_ml"
    )

    (cond
    ((>= dy 0) (setq pstr (mapcar '+ pp3 (list -d1 d1))))
    ((< dy 0) (setq pstr ptst))
    )
    )

    ((< ynpr 0)
    (setq ptst (mapcar '+ pp3 (list -d1 -d2))
    tipvst "_mr"
    )

    (cond
    ((< dy 0) (setq pstr (mapcar '+ pp3 (list -d1 -d1))))
    ((>= dy 0) (setq pstr ptst))
    )
    )
    )
    )
    )

    (setq txt (rtos (* (abs dy) 1000) 2 0))
    (if (= k 1) (setq txt (strcat "Н" txt)) (setq txt (strcat "В" txt)))
    (cond ((>= dy 0) (setq rotstr "90"))
    ((< dy 0) (setq rotstr "270"))
    )

    (command "_insert" "strela" "_non" pstr mbstr mbstr rotstr)
    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    ;(if (= k 2)

    ; (command "_insert" "krug" "_non" pstr mbstr mbstr rotstr))

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    (if (> (* (abs dy) 1000) dopusk)
    (command "_color" "_r")
    )
    (command "_text" "_j" tipvst "_non" ptst mbtxt rottxt txt)
    )
    )
    (setq k (+ 1 k))
    )
    )
    )


     
  8. monolit

    monolit Форумчанин

    Спасибо. Тоже хорошо, но ФФФ.png [В] / [Н] обязательно в блоке и разделены чертой ,
    буквы не должны быть в одной строчке с цифрой
     
  9. monolit

    monolit Форумчанин

    походу бесперспективняк ::dry.gif::
     
  10. Philin

    Philin Форумчанин

    Просто уж очень странное задание. Смысл его каков?

    Поняв смысл этих действий... может быть найдётся уже готовая программа с решением вашей задачи.
     
  11. monolit

    monolit Форумчанин

    Все просто в существующей версии префикс либо суффикс и значение отклонений представляют собой одну строчку через пробел , при корректировке исполнительной под сдачу можно онанистом стать перебирая клавиши.
    Поэтому большая просьба заключить [В][Н] в блок. А черта это некая привязка стрелок к конструктиву , можно и без нее ну тогда хотя бы уменьшить на 2/3 отступ стрелок от конструкции (далековато получается).
     
    nburdinskji нравится это.
  12. Philin

    Philin Форумчанин

    Подразумевается подгонометрия? Если да, то мои программы не пробовали? Одной рисуем, а вторая подгонит всю съёмку одним кликом мыши (программе всё равно В там или Н или вообще высотная съёмка... сама поймёт что это такое и подгонит под требуемые параметры. Правда подгоняет только съёмки выполненные моими же программами...).
     
  13. monolit

    monolit Форумчанин

    все правильно, а о каких ваших прогах идет речь .
     
  14. monolit

    monolit Форумчанин

    Все нашел , я знаком с ними . Но не в обиду сказано ,как то не с руки они мне
     
  15. Вопрос такой, как сделать буквы [В] [Н] отдельно от блока
     

    Вложения:

    • lsp.jpg
      lsp.jpg
      Размер файла:
      96 КБ
      Просмотров:
      42
    • блок.jpg
      блок.jpg
      Размер файла:
      194,8 КБ
      Просмотров:
      42
    • откл стен.lsp
      Размер файла:
      4,6 КБ
      Просмотров:
      14
  16. Philin

    Philin Форумчанин

    А на практике для чего это нужно?
     
  17. OlVish

    OlVish Форумчанин

    monolit,
    что-то такое уже было, вдруг поможет
    здесь
     
  18. С подгоном всё отлично! Вы создали еще программу которая поворачивает стрелки. Как убрать тот случай, когда отклонение конструкции изначально было в разные стороны от проектной линии, мы повернули ''понравившиеся" стрелки и получились стрелки направленные в одну сторону, и осталась одна старая стрелка с обозначениями верха и низа. Вместе они ВЫГЛЯДЯТ НЕ ОЧЕНЬ!!!
     

    Вложения:

  19. Philin

    Philin Форумчанин

    В моей практике такие случаи настолько редки, что нет никаких проблем поправить вручную пару стрелок на всём чертеже. Чисто теоретически можно это решить программно, но затраты на переделку программы по времени примерно будут равны обработке вручную сотен таких чертежей.

    PS Скрин настолько мелкий, что на нём ничего не разобрать. Вижу только, что есть значения В и Н и созданы они либо внучную, либо не моей программой (моя программа пишет типа В25, а на вашем скрине типа 25В). Не знаю откуда эта буква после числа, но по ГОСТ буква должна быть перед числом.
     
  20. Андрей_

    Андрей_ Форумчанин

    Пользователь Андрей_ разместил новый ресурс:

    Несколько слов об ошибках в Geo_Tools - Здесь что то вроде FAQ пополам с особенностями geo_tools.

    Узнать больше об этом ресурсе...
     
    -=13=- нравится это.
  1. Этот сайт использует файлы cookie. Продолжая пользоваться данным сайтом, Вы соглашаетесь на использование нами Ваших файлов cookie.
    Скрыть объявление
  1. Этот сайт использует файлы cookie. Продолжая пользоваться данным сайтом, Вы соглашаетесь на использование нами Ваших файлов cookie.
    Скрыть объявление