• Откуда: Казахстан / Костанай
  • На форуме с 17 октября 2016г.
  • Сообщений: 1
  • Спасибо: 0

Тема: Уклон газопровода в промилле

Здравствуйте уважаемые форумчане.Я работаю проектировщиком по газоснабжению и приходится делать много километров профилей. Хочу попросить Вас о помощи. Нужен лисп для расчета уклона газопровода в промилле.Суть задачи в следующем: есть две отметки (мтекст)-одна большая, другая меньшая и длина участка (мтекст). Отметки-с двумя знаками после запятой, длина участка-с одним знаком. Указываем на экране большую отметку, меньшую отметку и длину участка. Программа считает уклон по формуле:(большая отметка-меньшая отметка)х1000/длину участка, и заменяет любой указанный мтекст на значение рассчитанного уклона с двумя знаками после запятой. Разделитель именно запятая. Конечно, все это считается на простом калькуляторе или в Exсel, что я собственно и делаю. Но с липсом было бы гараздо оперативнее. В нете к сожалению ничего похожего найти не удалось.Буду признателен всем кто отзовется.

Ответ от mr_runa (изменено: runa, 15 ноября 2017г. 10:21:34)

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

Re: Уклон газопровода в промилле

Давно не писал на лиспе. Протестируйте сначала хорошенько.
Работает только с мтекстами.

;|
    Вызов программы команда promille
    Сначала указываем длину а потом уже отметки.
    Можно указывать сначала меньшую отметку, разница берется по модулю.
|;

(defun c:promille (/ dist elev1 elev2 mtext promi)

  (defun get_mtext (str / mtext)
    (if    (and
      (setq mtext (entsel str))
      (setq mtext (car mtext))
      (equal (assoc 0 (entget mtext)) '(0 . "MTEXT"))
    )
      mtext
    )
  )

  (defun mtext2number (entity /)
    (atof (vl-string-subst "." "," (cdr (assoc 1 (entget entity)))))
  )


  (if (and
    (setq dist (get_mtext "\nDistance: "))
    (setq dist (mtext2number dist))
    (/= dist 0)

    (setq elev1 (get_mtext "\nStart elevation: "))
    (setq elev1 (mtext2number elev1))

    (setq elev2 (get_mtext "\nEnd elevation: "))
    (setq elev2 (mtext2number elev2))

    (setq promi (vl-string-subst "," "." (rtos (/ (abs (- elev2 elev1)) dist 0.001) 2 2)))

    (setq mtext (get_mtext (strcat "\nMtext (" promi "): ")))
      )
    (progn
      (setq mtext (entget mtext))
      (entmod (subst (cons 1 promi) (assoc 1 mtext) mtext))
    )
  )
  (princ)
)

ЗЫ. Ха, на дату не глянул, ну да ладно, лучше поздно чем никогда)