• На форуме с 16 мая 2006г.
  • Сообщений: 29
  • Спасибо: 0

Тема: Простановка длин полилиний

Уважаемые профи, погите пожалуйста найти такую программку (LISP), где я указываю мышкой полилинию, а она мне ставит в середину указанной полилинии полную ее длину. Спасибо!

  • На форуме с 29 сентября 2006г.
  • Сообщений: 55
  • Спасибо: 0

Re: Простановка длин полилиний

а полилиния ломаная, если нет то в измерениях есть функция выбрать объект, выделишь полилинию, будет длина, от точки до точки указывать не нужно

  • Fatty
  • Восстановленный участник
  • На форуме с 30 мая 2006г.
  • Сообщений: 989
  • Спасибо: 0

Re: Простановка длин полилиний

> Laidi
Не особо проверял, собрано с разных кусков
вроде работает на первый взгляд

(defun C:PNT
       (/ *Error* *Debug* acsp adoc ang axss len otxt pt ss txt)
  (vl-load-com)
  ;=================================================;
  (defun *Error* (msg)
    (cond ((not msg))
      ((member msg '("Function cancelled" "quit / exit abort")))
      ((princ (strcat "\nError: " msg))
       (cond (*Debug* (vl-bt)))
      )
    )
    (vla-endundomark
      (vla-get-activedocument (vlax-get-acad-object))
    )
  )
  ;=================================================;
  (defun alg-ang (obj pnt)
    (angle '(0. 0. 0.)
       (vlax-curve-getfirstderiv
         obj
         (vlax-curve-getparamatpoint
           obj
           pnt
         )
       )
    )
  )
  ;=================================================;
  (or adoc
      (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  )
  (or acsp
      (setq acsp
         (if (or (= (getvar "TILEMODE") 1)
             (> (getvar "CVPORT") 1)
         )
           (vla-get-modelspace adoc)
           (vla-get-paperspace adoc)
         )
      )
  )
  (vla-startundomark
    adoc
  )
  (if (< (atof (getvar "ACADVER")) 15.02)
    (progn
      (alert
    "Для работы программы требуется\nАвтоКАД версии 2000 и выше"
      )
      (exit)
      (princ)
    )
  )
  (prompt "\n\t***\tВыбрать полилинии для простановки длины\t***\n")
  (if (setq ss (ssget (list (cons 0 "*POLYLINE"))))
      (progn
      (setq axss (vla-get-activeselectionset adoc))
      (vlax-for    a axss
    (setq
      len (vlax-curve-getdistatparam a (vlax-curve-getendparam a))
    )
    (setq pt (vlax-curve-getpointatparam
           a
           (/ (vlax-curve-getendparam a) 2.0)
         )
    )
    (setq otxt (vlax-invoke
            acsp
            'AddText
            (rtos len 2 3)
            pt
            (getvar "dimtxt");|<--можно указать вместо конкретную высоту текста|;
          )
    )
    (setq ang (alg-ang a pt))
    (vlax-put otxt 'Rotation ang)
    (vlax-put otxt 'Alignment 13)
    (vlax-put otxt 'TextalignmentPoint pt)
    (vla-update otxt)
      )
    )
    (alert "Ничего не выбрано.Повторить")
  )
  (vla-endundomark
    adoc
  )
  (*Error* nil)
  (princ)
)
(prompt "\n\t***\tУтилита образмеривания полилиний загружена\t***\n")
(prompt "\t***\tВведите в командной строке PNT для выполнения\t***\n")
(princ)
;; TesT : (C:PNT)

~'J'~

  • На форуме с 16 мая 2006г.
  • Сообщений: 29
  • Спасибо: 0

Re: Простановка длин полилиний

> Fatty
Огромное спасибо - все работает!!!

  • На форуме с 16 мая 2006г.
  • Сообщений: 29
  • Спасибо: 0

Re: Простановка длин полилиний

> Fatty
Наглость конечно, но хочу еще попросить, чтобы сразу установить в LISP-е точность до 2-х знаков после запятой. Пожалуйста!

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 23

Re: Простановка длин полилиний

(defun c:pnt (/ *error* *debug* acsp adoc ang axss len otxt pt ss txt)
  (vl-load-com)
  (defun *error* (msg)
    (cond
      ((not msg))
      ((member msg '("Function cancelled" "quit / exit abort")))
      ((princ (strcat "\nError: " msg))
       (cond (*debug* (vl-bt)))
       )
      ) ;_ end of cond
    (vla-endundomark
      (vla-get-activedocument (vlax-get-acad-object))
      ) ;_ end of vla-endundomark
    ) ;_ end of defun
  (defun alg-ang (obj pnt)
    (angle '(0. 0. 0.)
           (vlax-curve-getfirstderiv
             obj
             (vlax-curve-getparamatpoint
               obj
               pnt
               ) ;_ end of vlax-curve-getparamatpoint
             ) ;_ end of vlax-curve-getfirstderiv
           ) ;_ end of angle
    ) ;_ end of defun
  (or adoc
      (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
      ) ;_ end of or
  (or acsp
      (setq acsp
             (if (or (= (getvar "TILEMODE") 1)
                     (> (getvar "CVPORT") 1)
                     ) ;_ end of or
               (vla-get-modelspace adoc)
               (vla-get-paperspace adoc)
               ) ;_ end of if
            ) ;_ end of setq
      ) ;_ end of or
  (vla-startundomark
    adoc
    ) ;_ end of vla-startundomark
  (if (< (atof (getvar "ACADVER")) 15.02)
    (progn
      (alert
        "Для работы программы требуется\nАвтоКАД версии 2000 и выше"
        ) ;_ end of alert
      (exit)
      (princ)
      ) ;_ end of progn
    ) ;_ end of if
  (prompt "\n\t***\tВыбрать полилинии для простановки длины\t***\n")
  (if (setq ss (ssget (list (cons 0 "*POLYLINE"))))
    (progn
      (setq axss (vla-get-activeselectionset adoc))
      (vlax-for a axss
        (setq
          len (vlax-curve-getdistatparam a (vlax-curve-getendparam a))
          ) ;_ end of setq
        (setq pt (vlax-curve-getpointatparam
                   a
                   (/ (vlax-curve-getendparam a) 2.0)
                   ) ;_ end of vlax-curve-getpointatparam
              ) ;_ end of setq
        (setq otxt (vlax-invoke
                     acsp
                     'addtext
                     (rtos len 2 [b]2[/b])
          ; Вторая цифра - точность, знаков после запятой (по идее)
                     pt
                     (getvar "dimtxt")
                     ;|<--можно указать вместо конкретную высоту текста|;
                     ) ;_ end of vlax-invoke
              ) ;_ end of setq
        (setq ang (alg-ang a pt))
        (vlax-put otxt 'rotation ang)
        (vlax-put otxt 'alignment 13)
        (vlax-put otxt 'textalignmentpoint pt)
        (vla-update otxt)
        ) ;_ end of vlax-for
      ) ;_ end of progn
    (alert "Ничего не выбрано.Повторить")
    ) ;_ end of if
  (vla-endundomark
    adoc
    ) ;_ end of vla-endundomark
  (*error* nil)
  (princ)
  ) ;_ end of defun
(prompt "\n\t***\tУтилита образмеривания полилиний загружена\t***\n")
(prompt "\t***\tВведите в командной строке PNT для выполнения\t***\n")
(princ)
;; TesT : (C:PNT)

Вроде так. Если что, автор поправит :)

  • Fatty
  • Восстановленный участник
  • На форуме с 30 мая 2006г.
  • Сообщений: 989
  • Спасибо: 0

Re: Простановка длин полилиний

> Кулик Алексей aka kpblc
Алексей, спасибо
Тебе как себе доверяю, даже больше
:)

  • На форуме с 16 мая 2006г.
  • Сообщений: 29
  • Спасибо: 0

Re: Простановка длин полилиний

Спасибо! Спасибо!! Спасибо!!!

  • iv
  • Восстановленный участник
  • На форуме с 24 ноября 2006г.
  • Сообщений: 173
  • Спасибо: 0

Re: Простановка длин полилиний

> Кулик Алексей aka kpblc
Мне кстати периметр тоже нужен... Просто жду когда set-area будет ideal :).
Пока для периметра пользуюсь старой самоделкой ...
Предложенная тобой, на сложных замкнутых линиях расставляет длину (периметры) где попало. А желательно чтоб в точке указанной мной, на определенном слое и Snap чтобы тоже был. А также желателен предложенный тобой вариант перевода из милиметров в метры.

  • На форуме с 25 января 2012г.
  • Сообщений: 24
  • Спасибо: 1

Re: Простановка длин полилиний

Спасибо Fatty и Алексею, и мне понабился этот код. Очень доволен. Только код Алексея не запустился, уверен там все правильно, у меня наверное такие руки...

В коде Fatty вставил вместо (getvar "dimtxt") высоту текста цифрой, т.е. вместо:

(setq otxt (vlax-invoke
          acsp
          'AddText
          (rtos len 2 3)
          pt
          (getvar "dimtxt");|<--можно указать вместо конкретную высоту текста|;
        )

Получилось

(setq otxt (vlax-invoke
          acsp
          'AddText
          (rtos len 2 3)
          pt
          10;|<--можно указать вместо конкретную высоту текста|;
        )

Для программистов это элементарно, но форум читают и обычные пользователи, как я, поэтому подумал , может кому будет полезно...

  • На форуме с 12 апреля 2020г.
  • Сообщений: 8
  • Спасибо: 0

Re: Простановка длин полилиний

Спасибо за программу Все работает