1. ВНИМАНИЕ! В течении пары дней +- будет переезд форума на более защищённый сервер. Возможны периодические перебои в работе.

Отрисовка высотных отметок

Discussion in 'Autodesk' started by Shemba, May 11, 2014.

  1. Shemba

    Shemba Форумчанин

    Здравствуйте, уважаемые!
    Поделитесь опытом, как отобразить высоты в плане, наименьшими усилиями?

    Пример
    Точки топосъемки были закинуты в кад и отредактированы. Т.к. съемка местности была выполнена до получения gps измерений - все высоты "подвинулись". Теперь нужно возле каждой точки (а их под 1к) проставить высотную отметку. Пока я додумался конвертацией в прогу к прибору и назад (но способ не самый гуманный :)

    Собственно вот такая дилемма. Всем спасибо, за ответы!

    С Уважением, Shemba
     
  2. Qvinto

    Qvinto Форумчанин

    Если съемочные пикеты в виде точек Автокада, и высоты поменяны у них правильно то используй простенький лисп.
    Code:
    (defun c:pl ( / H SSET lay osm npoint n ent pxy pz)
    (if(and
    (setq sset (ssget '((0 . "POINT"))))
    (setq h (getreal "\tУкажи высоту текста\t\t")))
    (mapcar(function(lambda  (x)
    (entmake(list '(0 . "text")
    (assoc 10 (entget x))(cons 40 h)
    (cons 1 (rtos (cadddr (assoc 10 (entget x))) 2 2))))))
    (vl-remove-if (function listp)
    (mapcar (function cadr) (ssnamex sset)))))
    (princ))
    Вообще-то надо бы знать, что ты поменял и как? Тогда и решение задачи будет иное. Например, http://geodesist.ru/forum/threads/Надстройки-по-геодезии-к-autocad.4611/#post-68093
     
  3. Shemba

    Shemba Форумчанин

    Qvinto лисп хороший, помог.
    Скажите, а если использовать его не для топо, где нужна точность 3-го знака после запятой (0,000), как можно изменить это в лиспе?

    С Уважением, Shemba
     
  4. Qvinto

    Qvinto Форумчанин

    Можно, изменив в коде отображение текста до трёх знаков.
    Найди различие, а лучше, сам немного изучи язык программирования .
    Code:
    (defun c:pl3 ( / H SSET lay osm npoint n ent pxy pz)
    (if(and
    (setq sset (ssget '((0 . "POINT"))))
    (setq h (getreal "\tУкажи высоту текста\t\t")))
    (mapcar(function(lambda  (x)
    (entmake(list '(0 . "text")
    (assoc 10 (entget x))(cons 40 h)
    (cons 1 (rtos (cadddr (assoc 10 (entget x))) 2 3))))))
    (vl-remove-if (function listp)
    (mapcar (function cadr) (ssnamex sset)))))
    (princ))
     
  5. Shemba

    Shemba Форумчанин

    Спасибо!
     
  6. Temich0000

    Temich0000 Форумчанин

    а можно для новичков, как в автокаде отметку высоты сделать до 2 знаков после запятой пример 32.01
     
  7. Qvinto

    Qvinto Форумчанин

    Воспользоваться соответствующим приложением.
    Запускается командой RN

    Code:
    (defun prc ();Устанавливаем точность округления
    (setq prec0 (if (null prec) 0 prec))
    (if (vl-catch-all-error-p (vl-catch-all-apply '(lambda ()
    (setq prec (vla-getInteger util (strcat "Точноcть округления: <" (itoa prec0) ">? "))))))
    (setq prec prec0));if
    );defun
    ;
    (defun c:Rn (/ adoc util ass kw)
    (vl-load-com)
    (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))
    util (vla-get-utility adoc); утилита выбора
    ass (vla-get-activeselectionset adoc)); набор
    (vla-clear ass); очистка набора от прежней грязи
    (print "\nВыберите текст для округления: ")
    (vla-SelectOnScreen ass; выбор текстовых объектов
    (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 0)) '(0))
    (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 0)) '("*TEXT")))
    (vlax-for txt ass; очистка набора от буквенно-цифровых элементов
    (if (wcmatch (vla-get-TextString txt) "*@*")
    (vla-removeItems ass (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0)) (list txt))))));vlax-for
    (print (strcat "Можно округлить " (itoa (vla-get-count ass)) " чисел"))
    (vla-InitializeUserInput util 128 "Да Нет")
    (setq kw (vla-getKeyWord util "Округлять скопом [Да/Нет]: <Да>?"))
    (if (= kw "") (setq kw "Да"))
    (vla-StartUndoMark adoc)
    (if (= kw "Да") (progn (prc) (vlax-for txt ass (vla-put-TextString txt (rtos (atof (vla-get-TextString txt)) 2 prec))));progn
    (vlax-for txt ass
    (vla-highlight txt T)(prc) (vla-put-TextString txt (rtos (atof (vla-get-TextString txt)) 2 prec))));if
    (vla-EndUndoMark adoc)
    );end
    (defun prc ();Устанавливаем точность округления
    (setq prec0 (if (null prec) 0 prec))
    (if (vl-catch-all-error-p (vl-catch-all-apply '(lambda ()
    (setq prec (vla-getInteger util (strcat "Точноcть округления: ? "))))))
    (setq prec prec0));if
    );defun
    ;
    (defun c:Rn (/ adoc util ass kw)
    (vl-load-com)
    (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))
    util (vla-get-utility adoc); утилита выбора
    ass (vla-get-activeselectionset adoc)); набор
    (vla-clear ass); очистка набора от прежней грязи
    (print "\nВыберите текст для округления: ")
    (vla-SelectOnScreen ass; выбор текстовых объектов
    (vlax-safearray-fill (vlax-make-safearray vlax-vbinteger '(0 . 0)) '(0))
    (vlax-safearray-fill (vlax-make-safearray vlax-vbvariant '(0 . 0)) '("*TEXT")))
    (vlax-for txt ass; очистка набора от буквенно-цифровых элементов
    (if (wcmatch (vla-get-TextString txt) "*@*")
    (vla-removeItems ass (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0)) (list txt))))));vlax-for
    (print (strcat "Можно округлить " (itoa (vla-get-count ass)) " чисел"))
    (vla-InitializeUserInput util 128 "Да Нет")
    (setq kw (vla-getKeyWord util "Округлять скопом [Да/Нет]: ?"))
    (if (= kw "") (setq kw "Да"))
    (vla-StartUndoMark adoc)
    (if (= kw "Да") (progn (prc) (vlax-for txt ass (vla-put-TextString txt (rtos (atof (vla-get-TextString txt)) 2 prec))));progn
    (vlax-for txt ass
    (vla-highlight txt T)(prc) (vla-put-TextString txt (rtos (atof (vla-get-TextString txt)) 2 prec))));if
    (vla-EndUndoMark adoc)
    );end
     

    Attached Files:

    • RN.lsp
      File size:
      1.5 KB
      Views:
      92
    barabashkasathalex likes this.
  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice
  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice