• На форуме с 10 августа 2007г.
  • Сообщений: 63
  • Спасибо: 0

Тема: Профиль для исполнительных

Вот, написал код для построения продольного профиля теплосети (впрочем подойдет для любого профиля). Исходными данными являются результаты тахеометрической съемки, т. е. точки с определеннными координатами и высотой.

            ;
(defun dtr (a)
  (* pi (/ a 180.0))
)
(defun C:pro (/ dz ucs osn txt p pt1 pt2 ppt1 ppt2 tdis uk)
  (setq dz (getvar "DIMZIN"))
  (setvar "DIMZIN" 0)
  (setvar "CMDECHO" 0)
  (setq ucs (getpoint "\n Укажите точку где строить профиль: "))
  (command "_UCS" ucs "")
  (setq osn (getvar "OSMODE"))
  (setvar "OSMODE" 0)
                    ;Рисуем табличку
  (command "_rectang" '(0 0) '(85 10))
  (setq txt (substr "  Покрытие" 1))
  (command "_TEXT" "_ML" '(0 5) 3.5 "0" txt)
  (command "_rectang" '(0 20) '(85 10))
  (setq txt (substr "  Тип прокладки" 1))
  (command "_TEXT" "_ML" '(0 15) 3.5 "0" txt)
  (command "_rectang" '(0 20) '(85 40))
  (setq txt (substr "  План трассы" 1))
  (command "_TEXT" "_ML" '(0 30) 3.5 "0" txt)
  (command "_rectang" '(0 50) '(85 40))
  (command "_PLINE" '(0 50) '(85 40) "")
  (setq txt (substr "  Длина участка" 1))
  (command "_TEXT" "_ML" '(0 43) 3.5 "0" txt)
  (setq txt (substr "Уклон  " 1))
  (command "_TEXT" "_MR" '(85 47) 3.5 "0" txt)
  (command "_rectang" '(0 50) '(85 60))
  (setq txt (substr "  Расстояние" 1))
  (command "_TEXT" "_ML" '(0 55) 3.5 "0" txt)
  (command "_rectang" '(0 70) '(85 60))
  (setq txt (substr "  Глубина до верха канала" 1))
  (command "_TEXT" "_ML" '(0 65) 3.5 "0" txt)
  (command "_rectang" '(0 70) '(85 80))
  (setq txt (substr "  Глубина заложения низа канала" 1))
  (command "_TEXT" "_ML" '(0 75) 3.5 "0" txt)
  (command "_rectang" '(0 80) '(8 140))
  (setq txt (substr "Отметки" 1))
  (command "_TEXT" "_MC" '(4 110) 3.5 "90" txt)
  (command "_rectang" '(8 80) '(85 95))
  (setq txt (substr "  Осей труб" 1))
  (command "_TEXT" "_ML" '(8 87.5) 3.5 "0" txt)
  (command "_rectang" '(8 110) '(85 95))
  (setq txt (substr "  Низа канала или дна траншеи" 1))
  (command "_TEXT" "_ML" '(8 102.5) 3.5 "0" txt)
  (command "_rectang" '(8 110) '(85 125))
  (setq txt (substr "  Верха канала или верха труб" 1))
  (command "_TEXT" "_ML" '(8 117.5) 3.5 "0" txt)
  (command "_rectang" '(8 140) '(85 125))
  (setq txt (substr "  Планировки" 1))
  (command "_TEXT" "_ML" '(8 132.5) 3.5 "0" txt)
  (command "_rectang" '(0 140) '(85 150))
  (setq txt (substr "  Номера точек" 1))
  (command "_TEXT" "_ML" '(0 145) 3.5 "0" txt)
  (command "_PLINE"
       (setq p '(80 150))
       (setq p (polar p (dtr 90) 5))
       (setq p (polar p (dtr 180) 15))
       ""
  )
  (command "_PLINE"
       (setq p '(80 150))
       (setq p (polar p (dtr 45) 4))
       ""
  )
  (setq p (entlast))
  (command "_MIRROR" p "" '(80 150) '(80 151) "")
  (setq p (getstring "\n Условный горизонт:"))
  (command "_TEXT" '(66 156) 3.5 "0" p)
  (setq p (atof p))
  (setq txt (substr "М гор. 1:500" 1))
  (command "_TEXT" '(30 160) 3.5 "0" txt)
  (setq txt (substr "М вер. 1:100" 1))
  (command "_TEXT" '(30 154.5) 3.5 "0" txt)
  (command "_UCS" '(110 0) "")
  (setvar "OSMODE" 8)
  (setvar "PDMODE" 35)
  (setvar "PDSIZE" 1)
  (setq pt1 (getpoint "\n Укажите точку : "))
  (setq pt1 (trans pt1 1 0))
  (command "_PLINE"
       (list 0 150)
       (list 0 (+ 150 (* (- (last pt1) p) 10)))
       ""
  )
  (command "_TEXT"
       "_BC"
       (list 0 87.5)
       3.5
       "90"
       (rtos (last pt1) 2 2)
  )
  (while (setq pt2 (getpoint "\n Укажите точку (ENTER = хватит): "))
    (setq pt2 (trans pt2 1 0))
    (setq ppt1 (list (car pt1) (cadr pt1) 0))
    (setq ppt2 (list (car pt2) (cadr pt2) 0))
    (setq tdis (distance ppt1 ppt2))
    (setq uk (/ (- (last pt1) (last pt2)) tdis))
    (setvar "OSMODE" 0)
                    ; строим прямоугольники
    (command "_rectang"
         (list 0 140)
         "_D"
         (* tdis 2)
         10
         (list 1 140)
    )
    (command "_rectang"
         (list 0 125)
         "_D"
         (* tdis 2)
         15
         (list 1 125)
    )
    (command "_rectang"
         (list 0 110)
         "_D"
         (* tdis 2)
         15
         (list 1 110)
    )
    (command "_rectang"
         (list 0 95)
         "_D"
         (* tdis 2)
         15
         (list 1 95)
    )
    (command "_rectang"
         (list 0 80)
         "_D"
         (* tdis 2)
         15
         (list 1 80)
    )
                    ; пишем отметку оси
    (command "_TEXT"
         "_BC"
         (list (* tdis 2) 87.5)
         3.5
         "90"
         (rtos (last pt2) 2 2)
    )
                    ; написали
    (command "_rectang"
         (list 0 70)
         "_D"
         (* tdis 2)
         10
         (list 1 70)
    )
    (command "_rectang"
         (list 0 60)
         "_D"
         (* tdis 2)
         10
         (list 1 60)
    )
                    ; пишем длину
    (command "_TEXT"
         "_BC"
         (list tdis 52)
         3.5
         "0"
         (rtos tdis 2 2)
    )
                    ; написали
    (command "_rectang"
         (list 0 50)
         "_D"
         (* tdis 2)
         10
         (list 1 50)
    )
                    ; рисуем направление уклона
    (if    (> uk 0)
      (command "_PLINE" (list 0 50) (list (* tdis 2) 40) "")
      (command "_PLINE" (list 0 40) (list (* tdis 2) 50) "")
    )                    ;if
    (if    (= uk 0)
      (command "_erase" (entlast) "")
    )
                    ; нарисовали
                    ; пишем уклон и длину
    (if    (= uk 0)
      (progn
    (command "_TEXT"
         "_BC"
         (list tdis 44.13)
         3.5
         "0"
         (substr "0.000" 1)
    )
    (command "_TEXT"
         "_BC"
         (list tdis 40.13)
         3.5
         "0"
         (rtos tdis 2 2)
    )
      )                    ;progn
      (progn
    (if (> uk 0)
      (progn
        (command "_TEXT"
             "_MR"
             (list (- (* tdis 2) 1) 46)
             3.5
             "0"
             (rtos (abs uk) 2 4)
        )
        (command "_TEXT" "_ML" (list 1 44) 3.5 "0" (rtos tdis 2 2))
      )                ;progn
      (progn
        (command "_TEXT"
             "_Ml"
             (list 1 46)
             3.5
             "0"
             (rtos (abs uk) 2 4)
        )
        (command "_TEXT"
             "_MR"
             (list (- (* tdis 2) 1) 44)
             3.5
             "0"
             (rtos tdis 2 2)
        )
      )                ;progn
    )                ;if
      )                    ;progn
    )                    ;if
                    ; написали
    (command "_rectang"
         (list 0 40)
         "_D"
         (* tdis 2)
         10
         (list 1 40)
    )
    (command "_rectang"
         (list 0 20)
         "_D"
         (* tdis 2)
         20
         (list 1 20)
    )
    (command "_rectang"
         (list 0 10)
         "_D"
         (* tdis 2)
         10
         (list 1 10)
    )
    (command "_rectang"
         (list 0 0)
         "_D"
         (* tdis 2)
         10
         (list 1 0)
    )
                    ;построили
                    ;рисуем линии профиля
    (command "_PLINE"
         (list 0 (+ 150 (* (- (last pt1) p) 10)))
         "_W"
         0.6
         0.6
         (list (* tdis 2) (+ 150 (* (- (last pt2) p) 10)))
         ""
    )
    (command "_PLINE"
         (list (* tdis 2) 150)
         "_W"
         0
         0
         (list (* tdis 2) (+ 150 (* (- (last pt2) p) 10)))
         ""
    )
                    ;нарисовали
    (command "_UCS" (list (* tdis 2) 0) "")
    (print tdis)
    (print uk)
    (setq pt1 pt2)
    (setvar "OSMODE" 8)
  )                    ; while
  (command "_UCS" "_W")
  (setvar "OSMODE" osn)
  (setvar "DIMZIN" dz)
  (princ)
)                    ; defun

  • На форуме с 10 августа 2007г.
  • Сообщений: 63
  • Спасибо: 0

Re: Профиль для исполнительных

Сегодня вклеил в этот код программку написанную одним из обитателей этого форума. Теперь код проставляет пикеты на плане.

;; local defun
;; entmake text
(defun entmake-text (str tp)
  (entmake
    (list
      '(0 . "TEXT")            ;тип примитива
      '(100 . "AcDbEntity")        ;хз для чего надо, и без нее пашет норм
      '(100 . "AcDbText")        ;хз для чего надо, и без нее пашет норм
      (cons 1 str)            ;содержимое текста
      (cons 7 (getvar "textstyle"))    ;тектсовый стиль
      (cons 8 "0")            ;слой
      (cons 62 256)            ;цвет текста
      (cons 10 tp)            ;начальная точка
      (cons 11 tp)            ;точка выравнивания
      (cons 40 1.0)            ;высота текста
      (cons 41 1.0)            ;фактор сжатия
      (cons 50 0.0)            ;угол поворота в рад
      (cons 51 0.0)            ;угол наклона
      '(71 . 0)                ;флаги генерации
      '(72 . 1)                ;выравнивание по центру
      '(73 . 2)                ;хз для чего надо, и без нее пашет норм
    )                    ;list
  )                    ;entmake
  (princ)
)
(defun dtr (a)
  (* pi (/ a 180.0))
)
(defun C:pro (/ dz ucs osn txt p pt1 pt2 ppt1 ppt2 tdis uk)
  (setq dz (getvar "DIMZIN"))
  (setvar "DIMZIN" 0)
  (setvar "CMDECHO" 0)
  (setq ucs (getpoint "\n Укажите точку где строить профиль: "))
  (command "_UCS" ucs "")
  (setq osn (getvar "OSMODE"))
  (setvar "OSMODE" 0)
                    ;Рисуем табличку
  (command "_rectang" '(0 0) '(85 10))
  (setq txt (substr "  Покрытие" 1))
  (command "_TEXT" "_ML" '(0 5) 3.5 "0" txt)
  (command "_rectang" '(0 20) '(85 10))
  (setq txt (substr "  Тип прокладки" 1))
  (command "_TEXT" "_ML" '(0 15) 3.5 "0" txt)
  (command "_rectang" '(0 20) '(85 40))
  (setq txt (substr "  План трассы" 1))
  (command "_TEXT" "_ML" '(0 30) 3.5 "0" txt)
  (command "_rectang" '(0 50) '(85 40))
  (command "_PLINE" '(0 50) '(85 40) "")
  (setq txt (substr "  Длина участка" 1))
  (command "_TEXT" "_ML" '(0 43) 3.5 "0" txt)
  (setq txt (substr "Уклон  " 1))
  (command "_TEXT" "_MR" '(85 47) 3.5 "0" txt)
  (command "_rectang" '(0 50) '(85 60))
  (setq txt (substr "  Расстояние" 1))
  (command "_TEXT" "_ML" '(0 55) 3.5 "0" txt)
  (command "_rectang" '(0 70) '(85 60))
  (setq txt (substr "  Глубина до верха канала" 1))
  (command "_TEXT" "_ML" '(0 65) 3.5 "0" txt)
  (command "_rectang" '(0 70) '(85 80))
  (setq txt (substr "  Глубина заложения низа канала" 1))
  (command "_TEXT" "_ML" '(0 75) 3.5 "0" txt)
  (command "_rectang" '(0 80) '(8 140))
  (setq txt (substr "Отметки" 1))
  (command "_TEXT" "_MC" '(4 110) 3.5 "90" txt)
  (command "_rectang" '(8 80) '(85 95))
  (setq txt (substr "  Осей труб" 1))
  (command "_TEXT" "_ML" '(8 87.5) 3.5 "0" txt)
  (command "_rectang" '(8 110) '(85 95))
  (setq txt (substr "  Низа канала или дна траншеи" 1))
  (command "_TEXT" "_ML" '(8 102.5) 3.5 "0" txt)
  (command "_rectang" '(8 110) '(85 125))
  (setq txt (substr "  Верха канала или верха труб" 1))
  (command "_TEXT" "_ML" '(8 117.5) 3.5 "0" txt)
  (command "_rectang" '(8 140) '(85 125))
  (setq txt (substr "  Планировки" 1))
  (command "_TEXT" "_ML" '(8 132.5) 3.5 "0" txt)
  (command "_rectang" '(0 140) '(85 150))
  (setq txt (substr "  Номера точек" 1))
  (command "_TEXT" "_ML" '(0 145) 3.5 "0" txt)
  (command "_PLINE"
       (setq p '(80 150))
       (setq p (polar p (dtr 90) 5))
       (setq p (polar p (dtr 180) 15))
       ""
  )
  (command "_PLINE"
       (setq p '(80 150))
       (setq p (polar p (dtr 45) 4))
       ""
  )
  (setq p (entlast))
  (command "_MIRROR" p "" '(80 150) '(80 151) "")
  (setq p (getstring "\n Условный горизонт:"))
  (command "_TEXT" '(66 156) 3.5 "0" p)
  (setq p (atof p))
  (setq txt (substr "М гор. 1:500" 1))
  (command "_TEXT" '(30 160) 3.5 "0" txt)
  (setq txt (substr "М вер. 1:100" 1))
  (command "_TEXT" '(30 154.5) 3.5 "0" txt)
  (command "_UCS" '(110 0) "")
  (setvar "OSMODE" 8)
  (setvar "PDMODE" 35)
  (setvar "PDSIZE" 1)
  (setq dis 0.0)
  (setq str "ПК 00+00.00")
  (setq pt1 (getpoint "\n Укажите точку : "))
  (setq pt1 (trans pt1 1 0))
  (setq tp (list (car pt1) (+ (cadr pt1) 1) 0))
  (entmake-text str tp)
  (command "_PLINE"
       (list 0 150)
       (list 0 (+ 150 (* (- (last pt1) p) 10)))
       ""
  )
  (command "_TEXT"
       "_BC"
       (list 0 87.5)
       3.5
       "90"
       (rtos (last pt1) 2 2)
  )
  (while (setq pt2 (getpoint "\n Укажите точку (ENTER = хватит): "))
    (setq pt2 (trans pt2 1 0))
    (setq ppt1 (list (car pt1) (cadr pt1) 0))
    (setq ppt2 (list (car pt2) (cadr pt2) 0))
    (setq tdis (distance ppt1 ppt2))
    (setq dis (+ dis (distance ppt1 ppt2)))
    (setq da   (fix (/ dis 100))
      head (if (< da 10)
         (strcat "0" (rtos da 2 0))
         (rtos da 2 0)
           )
    )                    ;setq da
    (setq tail (rtos (- dis (* da 100)) 2 2))
    (setq str (strcat "ПК" (chr 32) head "+" tail))
    (setq tp (list (car pt2) (+ (cadr pt2) 1) 0))
    (entmake-text str tp)
    (setq uk (/ (- (last pt1) (last pt2)) tdis))
    (setvar "OSMODE" 0)
                    ; строим прямоугольники
    (command "_rectang"
         (list 0 140)
         "_D"
         (* tdis 2)
         10
         (list 1 140)
    )
    (command "_rectang"
         (list 0 125)
         "_D"
         (* tdis 2)
         15
         (list 1 125)
    )
    (command "_rectang"
         (list 0 110)
         "_D"
         (* tdis 2)
         15
         (list 1 110)
    )
    (command "_rectang"
         (list 0 95)
         "_D"
         (* tdis 2)
         15
         (list 1 95)
    )
    (command "_rectang"
         (list 0 80)
         "_D"
         (* tdis 2)
         15
         (list 1 80)
    )
                    ; пишем отметку оси
    (command "_TEXT"
         "_BC"
         (list (* tdis 2) 87.5)
         3.5
         "90"
         (rtos (last pt2) 2 2)
    )
                    ; написали
    (command "_rectang"
         (list 0 70)
         "_D"
         (* tdis 2)
         10
         (list 1 70)
    )
    (command "_rectang"
         (list 0 60)
         "_D"
         (* tdis 2)
         10
         (list 1 60)
    )
                    ; пишем длину
    (command "_TEXT"
         "_BC"
         (list tdis 52)
         3.5
         "0"
         (rtos tdis 2 2)
    )
                    ; написали
    (command "_rectang"
         (list 0 50)
         "_D"
         (* tdis 2)
         10
         (list 1 50)
    )
                    ; рисуем направление уклона
    (if    (> uk 0)
      (command "_PLINE" (list 0 50) (list (* tdis 2) 40) "")
      (command "_PLINE" (list 0 40) (list (* tdis 2) 50) "")
    )                    ;if
    (if    (= uk 0)
      (command "_erase" (entlast) "")
    )
                    ; нарисовали
                    ; пишем уклон и длину
    (if    (= uk 0)
      (progn
    (command "_TEXT"
         "_BC"
         (list tdis 44.13)
         3.5
         "0"
         (substr "0.000" 1)
    )
    (command "_TEXT"
         "_BC"
         (list tdis 40.13)
         3.5
         "0"
         (rtos tdis 2 2)
    )
      )                    ;progn
      (progn
    (if (> uk 0)
      (progn
        (command "_TEXT"
             "_MR"
             (list (- (* tdis 2) 1) 46)
             3.5
             "0"
             (rtos (abs uk) 2 4)
        )
        (command "_TEXT" "_ML" (list 1 44) 3.5 "0" (rtos tdis 2 2))
      )                ;progn
      (progn
        (command "_TEXT"
             "_Ml"
             (list 1 46)
             3.5
             "0"
             (rtos (abs uk) 2 4)
        )
        (command "_TEXT"
             "_MR"
             (list (- (* tdis 2) 1) 44)
             3.5
             "0"
             (rtos tdis 2 2)
        )
      )                ;progn
    )                ;if
      )                    ;progn
    )                    ;if
                    ; написали
    (command "_rectang"
         (list 0 40)
         "_D"
         (* tdis 2)
         10
         (list 1 40)
    )
    (command "_rectang"
         (list 0 20)
         "_D"
         (* tdis 2)
         20
         (list 1 20)
    )
    (command "_rectang"
         (list 0 10)
         "_D"
         (* tdis 2)
         10
         (list 1 10)
    )
    (command "_rectang"
         (list 0 0)
         "_D"
         (* tdis 2)
         10
         (list 1 0)
    )
                    ;построили
                    ;рисуем линии профиля
    (command "_PLINE"
         (list 0 (+ 150 (* (- (last pt1) p) 10)))
         "_W"
         0.6
         0.6
         (list (* tdis 2) (+ 150 (* (- (last pt2) p) 10)))
         ""
    )
    (command "_PLINE"
         (list (* tdis 2) 150)
         "_W"
         0
         0
         (list (* tdis 2) (+ 150 (* (- (last pt2) p) 10)))
         ""
    )
                    ;нарисовали
    (command "_UCS" (list (* tdis 2) 0) "")
    (print tdis)
    (print uk)
    (setq pt1 pt2)
    (setvar "OSMODE" 8)
  )                    ; while
  (command "_UCS" "_W")
  (setvar "OSMODE" osn)
  (setvar "DIMZIN" dz)
  (princ)
)                    ; defun

  • Skif58
  • Skif58
  • Активный участник
  • Откуда: Хабаровский край / Комсомольск
  • На форуме с 10 марта 2007г.
  • Сообщений: 236
  • Спасибо: 0

Re: Профиль для исполнительных

> Skydog
Очень полезная штука! Но пока не разобрался... Может чиркнешь маленький мануальчик? Плиз!
А то у меня что-то текст из ячеек вылазит, привязки все слетают, профиль строится не вверх, а вниз... ???

  • На форуме с 10 августа 2007г.
  • Сообщений: 63
  • Спасибо: 0

Re: Профиль для исполнительных

to Skif
Текст вылетает - надо поставить ГОСТовский, или измени фактор сжатия в настройках стиля текста.
Привязки слетают - сделано специально, во время работы программы включена только привязка к точке.
А чтобы профиль нормально строится - надо указывать условный горизонт - в зависимости от высоты (координаты Z) исходных точек, т.е. к примеру результаты съемки водопровода - набор точек с высотами Z=от 170,05 до 171,10. Тогда, задав условный горизонт = 160.00 (через точку)
получим нормальный профиль.

  • На форуме с 10 августа 2007г.
  • Сообщений: 63
  • Спасибо: 0

Re: Профиль для исполнительных

Вот еще одно дополнение, проставляет углы поворота трассы. Больше не знаю, что еще можно добавить.
;; local defun
;; entmake text
(defun entmake-text (str tp rad hgt wdt ali ali2)
  (entmake
    (list
      '(0 . "TEXT")      ;тип примитива
      '(100 . "AcDbEntity")    ;хер знает для чего надо, и без нее пашет норм
      '(100 . "AcDbText")    ;хер знает для чего надо, и без нее пашет норм
      (cons 1 str)      ;содержимое текста
      (cons 7 (getvar "textstyle"))  ;тектсовый стиль
      (cons 8 "0")      ;слой
      (cons 62 256)      ;цвет текста
      (cons 10 tp)      ;начальная точка
      (cons 11 tp)      ;точка выравнивания
      (cons 40 hgt)      ;высота текста
      (cons 41 wdt)      ;фактор сжатия
      (cons 50 rad)      ;угол поворота в рад
      (cons 51 0.0)      ;угол наклона
      '(71 . 0)        ;флаги генерации
      (cons 72 ali)      ;выравнивание лево центр право
      (cons 73 ali2)      ;выравнивание низ середина верх
    )          ;list
  )          ;entmake
  (princ)
)
(defun dtr (a) (* pi (/ a 180.0)))
(defun C:pro (/ anngg dz ucs osn txt p pt1 pt2 ppt1 ppt2 tdis uk ang12)
  (if (= (tblsearch "block" "blck001") nil)
    (progn (setq namset (ssadd))
     (command "_PLINE" '(0 0) "_W" 0.3 0.3 '(0 2) "")
     (ssadd (entlast) namset)
     (command "_PLINE" '(0 4) "_W" 0.0 2.0 '(0 2) "")
     (ssadd (entlast) namset)
     (command "_block" "blck001" '(0.0 5.0 0.0) namset "")
    )          ;progn
  )          ;if
  (setq anngg (getvar "ANGBASE"))
  (setq dz (getvar "DIMZIN"))
  (setvar "DIMZIN" 0)
  (setvar "CMDECHO" 0)
  (setq ucs (getpoint "\n Укажите точку где строить профиль: "))
  (command "_UCS" ucs "")
  (setq osn (getvar "OSMODE"))
  (setvar "OSMODE" 0)
          ;Рисуем табличку
  (command "_rectang" "_w" 0 '(0 0) '(85 10))
  (setq txt (substr "  Покрытие" 1))
  (command "_TEXT" "_ML" '(0 5) 3.5 "0" txt)
  (command "_rectang" '(0 20) '(85 10))
  (setq txt (substr "  Углы поворота" 1))
  (command "_TEXT" "_ML" '(0 15) 3.5 "0" txt)
  (command "_rectang" '(0 20) '(85 40))
  (setq txt (substr "  План трассы. Пикетаж." 1))
  (command "_TEXT" "_ML" '(0 30) 3.5 "0" txt)
  (command "_rectang" '(0 50) '(85 40))
  (command "_PLINE" '(0 50) "_w" 0 0 '(85 40) "")
  (setq txt (substr "  Длина участка" 1))
  (command "_TEXT" "_ML" '(0 43) 3.5 "0" txt)
  (setq txt (substr "Уклон  " 1))
  (command "_TEXT" "_MR" '(85 47) 3.5 "0" txt)
  (command "_rectang" '(0 50) '(85 60))
  (setq txt (substr "  Расстояние" 1))
  (command "_TEXT" "_ML" '(0 55) 3.5 "0" txt)
  (command "_rectang" '(0 70) '(85 60))
  (setq txt (substr "  Глубина до верха канала" 1))
  (command "_TEXT" "_ML" '(0 65) 3.5 "0" txt)
  (command "_rectang" '(0 70) '(85 80))
  (setq txt (substr "  Глубина заложения низа канала" 1))
  (command "_TEXT" "_ML" '(0 75) 3.5 "0" txt)
  (command "_rectang" '(0 80) '(8 140))
  (setq txt (substr "Отметки" 1))
  (command "_TEXT" "_MC" '(4 110) 3.5 "90" txt)
  (command "_rectang" '(8 80) '(85 95))
  (setq txt (substr "  Осей труб" 1))
  (command "_TEXT" "_ML" '(8 87.5) 3.5 "0" txt)
  (command "_rectang" '(8 110) '(85 95))
  (setq txt (substr "  Низа канала или дна траншеи" 1))
  (command "_TEXT" "_ML" '(8 102.5) 3.5 "0" txt)
  (command "_rectang" '(8 110) '(85 125))
  (setq txt (substr "  Верха канала или верха труб" 1))
  (command "_TEXT" "_ML" '(8 117.5) 3.5 "0" txt)
  (command "_rectang" '(8 140) '(85 125))
  (setq txt (substr "  Планировки" 1))
  (command "_TEXT" "_ML" '(8 132.5) 3.5 "0" txt)
  (command "_rectang" '(0 140) '(85 150))
  (setq txt (substr "  Номера точек" 1))
  (command "_TEXT" "_ML" '(0 145) 3.5 "0" txt)
  (command "_PLINE"
     (setq p '(80 150))
     (setq p (polar p (dtr 90) 5))
     (setq p (polar p (dtr 180) 15))
     ""
  )
  (command "_PLINE"
     (setq p '(80 150))
     (setq p (polar p (dtr 45) 4))
     ""
  )
  (setq p (entlast))
  (command "_MIRROR" p "" '(80 150) '(80 151) "")
  (setq p (getstring "\n Условный горизонт:"))
  (command "_TEXT" '(66 156) 3.5 "0" p)
  (setq p (atof p))
  (setq txt (substr "М гор. 1:500" 1))
  (command "_TEXT" '(30 160) 3.5 "0" txt)
  (setq txt (substr "М вер. 1:100" 1))
  (command "_TEXT" '(30 154.5) 3.5 "0" txt)
  (command "_UCS" '(110 0) "")
  (setvar "OSMODE" 8)
  (setvar "PDMODE" 35)
  (setvar "PDSIZE" 1)
  (setq ali 1)
  (setq ali2 0)
  (setq dis 0.0)
  (setq str "ПК 00+00.00")
  (setq pt1 (getpoint "\n Укажите точку : "))
  (setq pt1 (trans pt1 1 0))
  (setq tp (list (car pt1) (+ (cadr pt1) 1) 0))
  (setq rad (dtr 0))
  (setq hgt 1.0)
  (setq wdt 1.0)
  (entmake-text str tp rad hgt wdt ali ali2)
  (setq rad (dtr 90))
  (setq tp '(-2.5 30))
  (setq tp (trans tp 1 0))
  (setq hgt 2.5)
  (setq wdt 1.0)
  (entmake-text str tp rad hgt wdt ali ali2)
  (command "_PLINE"
     (list 0 150)
     (list 0 (+ 150 (* (- (last pt1) p) 10)))
     ""
  )
  (command "_TEXT"
     "_BC"
     (list 0 87.5)
     3.5
     "90"
     (rtos (last pt1) 2 2)
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  Ц  И  К  Л  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (while (setq pt2 (getpoint "\n Укажите точку (ENTER = хватит): "))
    (setq pt2 (trans pt2 1 0))
    (setq ang12 (atoi (angtos (angle pt1 pt2) 0 0)))
    (if  (= dis 0)
      (setq ang12 nil)
    )
    (print ang12)
    (setvar "ANGBASE" anngg)
    (setq ppt1 (list (car pt1) (cadr pt1) 0))
    (setq ppt2 (list (car pt2) (cadr pt2) 0))
    (setq ali2 0)
    (setq ali 1)
    (setq tdis (distance ppt1 ppt2))
    (setq rad (dtr 0))
    (setq dis (+ dis (distance ppt1 ppt2)))
    (setq da   (fix (/ dis 100))
    head (if (< da 10)
     (strcat "0" (rtos da 2 0))
     (rtos da 2 0)
         )
    )          ;setq da
    (setq tail (rtos (- dis (* da 100)) 2 2))
    (setq str (strcat "ПК" (chr 32) head "+" tail))
    (setq tp (list (car pt2) (+ (cadr pt2) 1) 0))
    (setq hgt 1.0)
    (setq wdt 1.0)
    (entmake-text str tp rad hgt wdt ali ali2)
    (setq rad (dtr 90))
    (setq tp (list (- (* tdis 2) 2.5) 30))
    (setq tp (trans tp 1 0))
    (setq hgt 2.5)
    (setq wdt 1.0)
    (entmake-text str tp rad hgt wdt ali ali2)
    (setq uk (/ (- (last pt1) (last pt2)) tdis))
    (setvar "OSMODE" 0)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;Пишем углы поворота трассы
    (if  (= (type ang12) (type 1))
      (progn
  (setq tp (trans (list (+ 0 2) 15) 1 0))
  (setq hgt 3.5)
  (setq rad 0)
  (setq str (itoa ang12))
  (setq ali 0)
  (setq ali2 1)
  (if (> ang12 180)
    (progn (command "_insert" "blck001" '(0 10) 1 1 180)
     (setq ang12 (- 360 ang12)
           ali2  3
           str   (itoa ang12)
     )      ;setq
    )        ;progn
    (command "_insert" "blck001" '(0 20) 1 1 0)
  )        ;if
  (entmake-text str tp rad hgt wdt ali ali2)
      )          ;progn
    )          ;if
          ; строим прямоугольники
    (command "_rectang"
       (list 0 140)
       "_D"
       (* tdis 2)
       10
       (list 1 140)
    )
    (command "_rectang"
       (list 0 125)
       "_D"
       (* tdis 2)
       15
       (list 1 125)
    )
    (command "_rectang"
       (list 0 110)
       "_D"
       (* tdis 2)
       15
       (list 1 110)
    )
    (command "_rectang"
       (list 0 95)
       "_D"
       (* tdis 2)
       15
       (list 1 95)
    )
    (command "_rectang"
       (list 0 80)
       "_D"
       (* tdis 2)
       15
       (list 1 80)
    )
          ; пишем отметку оси
    (command "_TEXT"
       "_BC"
       (list (* tdis 2) 87.5)
       3.5
       "90"
       (rtos (last pt2) 2 2)
    )
          ; написали
    (command "_rectang"
       (list 0 70)
       "_D"
       (* tdis 2)
       10
       (list 1 70)
    )
    (command "_rectang"
       (list 0 60)
       "_D"
       (* tdis 2)
       10
       (list 1 60)
    )
          ; пишем длину
    (command "_TEXT"
       "_BC"
       (list tdis 52)
       3.5
       "0"
       (rtos tdis 2 2)
    )
          ; написали
    (command "_rectang"
       (list 0 50)
       "_D"
       (* tdis 2)
       10
       (list 1 50)
    )
          ; рисуем направление уклона
    (if  (> uk 0)
      (command "_PLINE" (list 0 50) (list (* tdis 2) 40) "")
      (command "_PLINE" (list 0 40) (list (* tdis 2) 50) "")
    )          ;if
    (if  (= uk 0)
      (command "_erase" (entlast) "")
    )
          ; нарисовали
          ; пишем уклон и длину
    (if  (= uk 0)
      (progn
  (command "_TEXT"
     "_BC"
     (list tdis 44.13)
     3.5
     "0"
     (substr "0.000" 1)
  )
  (command "_TEXT"
     "_BC"
     (list tdis 40.13)
     3.5
     "0"
     (rtos tdis 2 2)
  )
      )          ;progn
      (progn
  (if (> uk 0)
    (progn
      (command "_TEXT"
         "_MR"
         (list (- (* tdis 2) 1) 46)
         3.5
         "0"
         (rtos (abs uk) 2 4)
      )
      (command "_TEXT" "_ML" (list 1 44) 3.5 "0" (rtos tdis 2 2))
    )        ;progn
    (progn
      (command "_TEXT"
         "_Ml"
         (list 1 46)
         3.5
         "0"
         (rtos (abs uk) 2 4)
      )
      (command "_TEXT"
         "_MR"
         (list (- (* tdis 2) 1) 44)
         3.5
         "0"
         (rtos tdis 2 2)
      )
    )        ;progn
  )        ;if
      )          ;progn
    )          ;if
          ; написали
    (command "_rectang"
       (list 0 40)
       "_D"
       (* tdis 2)
       10
       (list 1 40)
    )
    (command "_rectang"
       (list 0 20)
       "_D"
       (* tdis 2)
       20
       (list 1 20)
    )
    (command "_rectang"
       (list 0 10)
       "_D"
       (* tdis 2)
       10
       (list 1 10)
    )
    (command "_rectang"
       (list 0 0)
       "_D"
       (* tdis 2)
       10
       (list 1 0)
    )
          ;построили
          ;рисуем линии профиля
    (command "_PLINE"
       (list 0 (+ 150 (* (- (last pt1) p) 10)))
       "_W"
       0.6
       0.6
       (list (* tdis 2) (+ 150 (* (- (last pt2) p) 10)))
       ""
    )
    (command "_PLINE"
       (list (* tdis 2) 150)
       "_W"
       0
       0
       (list (* tdis 2) (+ 150 (* (- (last pt2) p) 10)))
       ""
    )
          ;нарисовали
    (command "_UCS" (list (* tdis 2) 0) "")
    (print tdis)
    (print uk)
    (setvar "ANGBASE" (angle pt1 pt2))
    (setq pt1 pt2)
    (setvar "OSMODE" 8)
  )          ; while
  (setvar "ANGBASE" anngg)
  (command "_UCS" "_W")
  (setvar "OSMODE" osn)
  (setvar "DIMZIN" dz)
  (princ)
)          ; defun

  • Skif58
  • Skif58
  • Активный участник
  • Откуда: Хабаровский край / Комсомольск
  • На форуме с 10 марта 2007г.
  • Сообщений: 236
  • Спасибо: 0

Re: Профиль для исполнительных

> Skydog
Спасибо! Работает.При предварительной установке нужного сжатия текста, - все в ячейки профиля входит, кроме пикетажа. Его приходится отдельно сжимать...Направления углов - лучше бы стрелки..
Да, и отметки Оси труб, - это для меня новость... Поменяю на верх или низ...Но это все мелочи.
А вообще - чудо. Я в ручную рисовал..., - в Лиспе не рублю совсем... Нужно изучать...

  • Skif58
  • Skif58
  • Активный участник
  • Откуда: Хабаровский край / Комсомольск
  • На форуме с 10 марта 2007г.
  • Сообщений: 236
  • Спасибо: 0

Re: Профиль для исполнительных

> Skydog
Да, еще забыл,- для полного счастья, - хорошо бы, чтобы длина участка была не равна горизонтальному проложению(расстоянию), а была бы фактической, - в зависимости от уклона.

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

Re: Профиль для исполнительных

Ребята, научите долбоё....., а как это все использовать? Если можно с самого начала и поподробней.

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

Re: Профиль для исполнительных

dwg.ru/art/8

  • На форуме с 10 августа 2007г.
  • Сообщений: 63
  • Спасибо: 0

Re: Профиль для исполнительных

еще небольшой помощник для камеральщиков, чертит створ в половину здания, но не больше 50м.

(defun dtr (a) (* pi (/ a 180.0)))
(defun entmake-text (str tp rad hgt ali1 ali2)
  (entmake
    (list
      '(0 . "TEXT")            ;тип примитива
      '(100 . "AcDbEntity")        ;хер знает для чего надо, и без нее пашет норм
      '(100 . "AcDbText")        ;хер знает для чего надо, и без нее пашет норм
      (cons 1 str)            ;содержимое текста
      (cons 7 (getvar "textstyle"))    ;тектсовый стиль
      (cons 8 "0")            ;слой
      (cons 62 256)            ;цвет текста
      (cons 10 tp)            ;начальная точка
      (cons 11 tp)            ;точка выравнивания
      (cons 40 hgt)            ;высота текста
      '(41 . 1.0)            ;фактор сжатия
      (cons 50 rad)            ;угол поворота в рад
      '(51 . 0.0)            ;угол наклона
      '(71 . 0)                ;флаги генерации
      (cons 72 ali1)            ;выравнивание лево центр право
      (cons 73 ali2)            ;выравнивание низ середина верх
    )                    ;list
  )                    ;entmake
  (princ)
)
(defun entmake-pline (ps pn)
  (entmake
    (list
      '(0 . "LWPOLYLINE")        ;тип примитива
      '(100 . "AcDbEntity")
      '(8 . "0")
      '(100 . "AcDbPolyline")
      '(90 . 2)
      (cons 10 ps)
      (cons 10 pn)
    )                    ;list
  )                    ;entmake
  (princ)
)                    ;defun
(defun C:ff (/ oss ddd pst ps pn aan)
  (setq oss (getvar "OSMODE"))
  (setq ddd (getvar "DIMZIN"))
  (setvar "DIMZIN" 0)
                    ;готовим блок
(if (= (tblsearch "block" "4ert") nil)
  (progn (setq ps '(0 -0.5)
           pn '(0 0.5)
     )
     (entmake-pline ps pn)
     (command "_block" "4ert" '(0.0 0.0 0.0) (entlast) "")
  )                    ;progn
)                    ;if
                    ;блок готов
  (setq pst (getpoint "\n Укажите точку: "))
  (setq ps (getpoint "\n Укажите точку: "))
  (setq aan (angle pst ps))
                    ;штангу для 0,00
(setvar "OSMODE" 0)
(command "_INSERT" "4ert" ps 1 1 (angtos aan 1 4))
(setvar "OSMODE" oss)
                    ;штанга есть
  (setq dis (/ (distance pst ps) 2))
  (if (> dis 50)
    (setq dis 50)
  )
                    ;пишем 0,00
(if (> (sin aan) 0)
  (progn (setq tp   ps
           ali1 2
           ali2 1
           hgt  1.0
           str  "0.00  "
           rad  (- aan (dtr 90))
     )                ;setq
     (entmake-text str tp rad hgt ali1 ali2)
     (setq tp   (polar ps aan dis)
           ali1 2
           ali2 2
           hgt  1.0
           str  (strcat (rtos dis 2 2) "  ")
           rad  (- aan (dtr 90))
     )                ;setq
     (entmake-text str tp rad hgt ali1 ali2)
  )                    ;progn
  (progn (setq tp   ps
           ali1 2
           ali2 3
           hgt  1.0
           str  "0.00  "
           rad  (+ aan (dtr 90))
     )                ;setq
     (entmake-text str tp rad hgt ali1 ali2)
     (setq tp   (polar ps aan dis)
           ali1 2
           ali2 2
           hgt  1.0
           str  (strcat (rtos dis 2 2) "  ")
           rad  (+ aan (dtr 90))
     )                ;setq
     (entmake-text str tp rad hgt ali1 ali2)
  )                    ;progn
)                    ;if
                    ;написали 0,00
                    ;чертим линию створа
  (setq pn (polar ps aan dis))
  (entmake-pline ps pn)
                    ;начертили
(setq tp (polar pn aan 1.0))
                    ;штангу для dis
(setvar "OSMODE" 0)
(command "_INSERT" "4ert" pn 1 1 (angtos aan 1 4))
(setvar "OSMODE" oss)
                    ;есть штанга для dis
  (setq ps (polar pn (- aan (dtr 90)) 0.5))
  (setq pn (polar pn (+ aan (dtr 90)) 0.5))
  (entmake-pline ps pn)
  (setq ali1 0)
  (if (< (cos aan) 0)
    (setq aan  (- aan (dtr 180))
      ali1 2
    )
  )                    ;if
  (setq    ali2 0
    hgt  1.5
    str  "створ"
    rad  aan
  )
  (entmake-text str tp rad hgt ali1 ali2)
  (setvar "DIMZIN" ddd)
)                    ;defun

  • На форуме с 10 августа 2007г.
  • Сообщений: 63
  • Спасибо: 0

Re: Профиль для исполнительных

to skif
Направления углов поворота - стрелки, просто перед запуском надо отключить все привязки, или передвинуть в коде строчки

(setq osn (getvar "OSMODE"))
(setvar "OSMODE" 0)

под строчку

(defun C:pro (/ anngg dz ucs osn txt p pt1 pt2 ppt1 ppt2 tdis uk ang12)

Кстати про отметки осей - у нас в геотресте без них не принимают... Да и расстояния по идее надо не наклонные, а проложения, хотя там отличаться будет на копейки.
ЗЫ1 При некорректном завершении кода "pro" могут слетать системные переменные, в частности ANGBASE. Не знаю, может есть и покрасивее решение для углов поворота трассы...
ЗЫ2 Вообще это мой первый код :)

  • Skif58
  • Skif58
  • Активный участник
  • Откуда: Хабаровский край / Комсомольск
  • На форуме с 10 марта 2007г.
  • Сообщений: 236
  • Спасибо: 0

Re: Профиль для исполнительных

> Skydog
Спасибо!
Про отметки осей: хорошо, что у нас нет геотреста... Они что не любят СНиПы и ГОСТы? Или уже есть новые, с осями?
Никогда не встречал в проектных профилях Отметки оси трубы. Всегда низ или верх труб.
А исполнительный профиль,- по идее, по СНиПу и по ГОСТу, - делается по образу и подобию Проектного, с указанием фактических (действительных) отметок того же самого, т.е. верха или низа труб.
Это вы при съемке  труб сразу вводите поравку = минус радиус трубы что-ли? %-)
Горизонтальные проложения нужны, - спору нет. Я о Длине участка написанной под Уклоном.
Просто у нас нужны и наклонные, - труба газовая, толстенькая и длинненькая (сотни км), то по крутым сопкам прет, то круто под речки ныряет... Цена договорная - за километр. Проект меняется раз в неделю smile Длины проложенной трубы не знает никто... А это уже ни копейки, а десятки тысяч рублей...
З.Ы. Первый код сразу пошел на Производство! Поздравляю и желаю Успехов!