| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Помогите дополнить макрос простановки уклона

Помогите дополнить макрос простановки уклона

Ответ
Поиск в этой теме
Непрочитано 14.04.2015, 11:29 #1
Помогите дополнить макрос простановки уклона
MrBrown
 
ПенсионЭр
 
Регистрация: 26.06.2009
Сообщений: 359

Здравствуйте! Нашел неплохой макрос "uklon", проставляющий величину уклона отрезка при указании его начала и конца. Хочу дополнить макрос, чтобы тот проставлял ещё и длину отрезка.
Для этого в макросе добавил аргумент "dist" и добавил строки 13 и 41 (показаны красным).
Код:
[Выделить все]
 (defun c:uklon-dist (/ a a1 a2 ang b b1 b2 mp osm pt1 pt2 th txthgt ukl dist)
  (setq osm (getvar "osmode"))
  (setvar "osmode" 33)
  (setq th (getvar "dimtxt"))
  (setq txthgt (getreal (strcat "\nText height <" (rtos th 2 2) " >: ")))
  (if (not txthgt)(setq txthgt th))
  (setq pt1 (getpoint "\nSpecify a first point ( or Press Enter to Exit): "))
  (while  
  (setq pt2 (getpoint pt1 "\nSpecify next point : "))
  
  (setq ang (angle pt1 pt2))
  ;; math to get angle more readable
(setq dist (distance pt1 pt2))
  (setq ang(cond ((< (/ pi 2) ang (* pi 1.5))
        (+ pi ang))
               (T ang))
         )
  ;; get middle point
  (setq mp (mapcar '(lambda (a b)(/( + a b) 2)) pt1 pt2))
  (setq a1 (car pt1))
  (setq b1 (cadr pt1))
  (setq a2 (car pt2))
  (setq b2 (cadr pt2))

  (setq ukl (* (/ (- b2 b1) (- a1 a2)) 100))
  (if (< ukl 0)
    (setq ukl (* ukl -1))
  )
(entmake
  (list
    '(0 . "TEXT")
    '(100 . "AcDbEntity")
    '(67 . 0)
    '(410 . "Model")
    '(8 . "DIM")
    '(100 . "AcDbText")
    (cons 10 mp)
    (cons 11 (list (car mp) (+ (cadr mp) txthgt) 0.0))
    (cons 40 txthgt)
    (cons 1 (strcat (rtos ukl 2 3)"%"))
(cons 1 (strcat (rtos dist 2 3)"м"))
    (cons 50 ang)
    '(41 . 1.0)
    '(51 . 0.0)
    '(7 . "Standard")
    '(71 . 0)
    '(72 . 0)
    (cons 210 (list 0.0 0.0 1.0))
    '(73 . 2)))
  (setq pt1 pt2)
)
(setvar "osmode" osm)   
  (princ)

)
Теперь макрос показывает только размер отрезка.
Помогите соединить значения "ukl" и "dist", чтобы они проставлялись одновременно, причем уклон - сверху отрезка, а дистанция - снизу.
И ещё - что надо добавить в макрос, чтобы не выдавал ошибку при измерении строго вертикального отрезка?
Спасибо.

Последний раз редактировалось MrBrown, 14.04.2015 в 11:58. Причина: исправление
Просмотров: 3915
 
Непрочитано 14.04.2015, 13:05
#2
Геннадий aka PG

Машиностроение, Проектирование
 
Регистрация: 15.09.2003
Москва
Сообщений: 1,113
<phrase 1=


Вторая строка просто затирает первую, попробуй так
(cons 1 (strcat (rtos ukl 2 3)"% " (rtos dist 2 3)"М"))
;;(cons 1 (strcat (rtos dist 2 3)"М")) ;;
А при вертикальном направление происходит деление на ноль вот тут
(setq ukl (* (/ (- b2 b1) (- a1 a2)) 100))
надо просто при (- a1 a2) = 0 назначить уклон
__________________
С уважением,
Геннадий aka PG

Последний раз редактировалось Геннадий aka PG, 14.04.2015 в 13:48.
Геннадий aka PG вне форума  
 
Автор темы   Непрочитано 14.04.2015, 13:50
#3
MrBrown

ПенсионЭр
 
Регистрация: 26.06.2009
Сообщений: 359


Геннадий aka PG, с первым пунктом получилось, большое спасибо за помощь.
MrBrown вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Помогите дополнить макрос простановки уклона

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помогите написать макрос для разрыва отрезков и полилиний в AutoCad Green4x Программирование 2 01.12.2013 21:03
Прошу мастеров LISP сделать макрос, автоматически рисующий котлованы Малявка LISP 6 20.04.2013 12:06
Помогите, нужен макрос масштабирования размеров Малявка Программирование 17 31.07.2012 19:08