Комплект полезных утилит из BricsCad в AutoCAD (Страница 2 из 5)

;;; Вызов и обработка диалога UPSK_FRM.DCL
(defun upsk_dialog ()
    (setq     fr_blk     "upsk_data")
    (setq     fr_ori     "land")
    (setq     dcl_id     (load_dialog "BonusTools/upsk_frm.dcl"))
    (if (not (new_dialog "upsk_box" dcl_id))
    (exit)
    );if
  (action_tile "data" "(setq fr_blk \"upsk_data\")")
  (action_tile "km" "(setq fr_blk \"upsk_km\")")
  (action_tile "mo" "(setq fr_blk \"upsk_mo\")")
  (action_tile "kmd" "(setq fr_blk \"upsk_kmd\")")
  (action_tile "rasch1" "(setq fr_blk \"upsk_rasch1\")")
  (action_tile "rasch2" "(setq fr_blk \"upsk_rasch2\")")
  (action_tile "form_port" "(setq fr_ori \"port\")")
  (action_tile "form_land" "(setq fr_ori \"land\")")
  (action_tile "accept" "(setq idblk fr_blk) (done_dialog)")
  (start_dialog)
  (unload_dialog dcl_id)
  )
;;; Отрисовка рамок листа, вставка штампа
(defun format (w h / p0 p1 p2 p3 pt ce)
;;; w - ширина листа
;;; h - высота листа
;;; p0 - точка вставки внешней рамки
;;; p1 - верхний левый угол внутренней рамки
;;; p2 - верхний правый угол внутренней рамки
;;; p3 - нижний правый угол внутренней рамки
;;; pt, ce - для временного хранения данных
  (setq ce (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (upsk_dialog)
  (if (= fr_ori "port")
    (setq pt w
          w  h
          h  pt
    )
  )                                               
  (command "_layer" "_s" "DEFPOINTS" "")
  (setq p0 (getpoint "\nУкажите точку вставки <Enter для вставки в начало координат>:"))
  (if (= p0 nil) (setq p0 (list 0 0)))
  (command "_rectang" p0 (list (+ (nth 0 p0) w) (+ (nth 1 p0)h)))
  (setq p1 (list (+ (nth 0 p0) 20) (- (+ (nth 1 p0) h) 5)))
  (setq p2 (list (- (+ (nth 0 p0) w) 5) (- (+ (nth 1 p0)h) 5)))
  (setq p3 (list (- (+ (nth 0 p0) w) 5) (+ (nth 1 p0)5)))
  (command "_layer" "_s" "ОСНОВНАЯ_0.40" "")
  (command "_line" (list (+ (nth 0 p0) 20) (+ (nth 1 p0)5))
   p1 p2 p3 (list (+ (nth 0 p0) 20) (+ (nth 1 p0)5)) "")
  (command "-insert" "*BonusTools/upsk_bok" (list (+ (nth 0 p0) 20)
  (+ (nth 1 p0)5)) "1" "0")
  (command "-insert" (strcat "*BonusTools/" fr_blk) p3 "1" "0")
  (command "_zoom" "_e")
  (setvar "CMDECHO" ce)
  (princ)
)

;;; Вызов и обработка диалога UPSK_FRM.DCL
(defun upsk_dialog ()
    (setq     fr_blk     "upsk_data")
    (setq     fr_ori     "land")
    (setq     dcl_id     (load_dialog "BonusTools/upsk_frm.dcl"))
    (if (not (new_dialog "upsk_box" dcl_id))
    (exit)
    );if
  (action_tile "data" "(setq fr_blk \"upsk_data\")")
  (action_tile "km" "(setq fr_blk \"upsk_km\")")
  (action_tile "mo" "(setq fr_blk \"upsk_mo\")")
  (action_tile "kmd" "(setq fr_blk \"upsk_kmd\")")
  (action_tile "rasch1" "(setq fr_blk \"upsk_rasch1\")")
  (action_tile "rasch2" "(setq fr_blk \"upsk_rasch2\")")
  (action_tile "form_port" "(setq fr_ori \"port\")")
  (action_tile "form_land" "(setq fr_ori \"land\")")
  (action_tile "accept" "(setq idblk fr_blk) (done_dialog)")
  (start_dialog)
  (unload_dialog dcl_id)
  )
;;; Отрисовка рамок листа, вставка штампа
(defun format (w h / p0 p1 p2 p3 pt ce)
;;; w - ширина листа
;;; h - высота листа
;;; p0 - точка вставки внешней рамки
;;; p1 - верхний левый угол внутренней рамки
;;; p2 - верхний правый угол внутренней рамки
;;; p3 - нижний правый угол внутренней рамки
;;; p4 - верхний правій угол внешней рамки
;;; pt, ce - для временного хранения данных
  (setq ce (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (upsk_dialog)
  (if (= fr_ori "port")
    (setq pt w
          w  h
          h  pt
    )
  )                                               
  (command "_layer" "_s" "DEFPOINTS" "")
  (setq p0 (getpoint "\nУкажите точку вставки <Enter для вставки в начало координат>:"))
  (if (= p0 nil) (setq p0 (list 0 0)))
  (setq p4 (list (+ (nth 0 p0) w) (+ (nth 1 p0)h)))
  (command "_rectang" p0 p4)
  (setq p1 (list (+ (nth 0 p0) 20) (- (+ (nth 1 p0) h) 5)))
  (setq p2 (list (- (+ (nth 0 p0) w) 5) (- (+ (nth 1 p0)h) 5)))
  (setq p3 (list (- (+ (nth 0 p0) w) 5) (+ (nth 1 p0)5)))
  (command "_layer" "_s" "ОСНОВНАЯ_0.40" "")
  (command "_line" (list (+ (nth 0 p0) 20) (+ (nth 1 p0)5))
   p1 p2 p3 (list (+ (nth 0 p0) 20) (+ (nth 1 p0)5)) "")
  (command "-insert" "*BonusTools/upsk_bok" (list (+ (nth 0 p0) 20)
  (+ (nth 1 p0)5)) "1" "0")
  (command "-insert" (strcat "*BonusTools/" fr_blk) p3 "1" "0")
  (command "_zoom" "_w" p0 p4)
  (setvar "CMDECHO" ce)
  (princ)
)
  

/* UPSK_FRM.DCL - диалог для UPSK_FRM.MNL*/
upsk_box: dialog {
   label = "Основная надпись";
/* Выбор варианта основной надписи */
   : radio_column {
      label = "Форма основной надписи";
      : radio_button {
         label = "Общие данные - КМ, АР, АС, КМД, МО";
         key = "data";
         value = "1"; /* по умолчанию */
      }
      : radio_button {
         label = "Рабочие чертежи - КМ, КЖ, АР";
         key = "km";
      }
      : radio_button {
         label = "Материалы обследования - МО";
         key = "mo";
      }
      : radio_button {
         label = "Рабочие чертежи - КМД, АС";
         key = "kmd";
      }
      : radio_button {
         label = "Задание на расчет";
         key = "rasch1";
      }
         : radio_button {
         label = "Расчеты";
         key = "rasch2";
      }
   }
/* Выбор ориентации листа */
   : boxed_radio_row {
   label = "Ориентация листа";
      : radio_button {
         label = "Книжная";
         key = "form_port";
      }
      : radio_button {
         label = "Альбом";
         key = "form_land";
         value = 1; /* по умолчанию */
      }
   }
ok_only;
}

(defun C:uzeln ( / llen tce tvn tvr tvl ttr ttr0 ttl tt0 tpl)
;;Функция отмены и выхода
(defun *error* (msg)
  (if (= msg "quit / exit abort")
  (princ)
  );if
);defun
(setvar "cmdecho" 0)
    (setq txt1 (getstring "\n\n Введите порядковый номер узла (<1>):"))
  (if
    (= txt1 "") (setq txt1 "1")
    );if
    (setq txt2 (getstring "\n\n Введите адрес узла (<1>):"))
  (if
    (= txt2 "") (setq txt2 "1")
    );if
       (setq llen (* 2.2 (strlen txt2)))
       (if
       (>= (strlen txt1) (strlen txt2))
       (setq llen (* 3.5 (strlen txt1)))
       );if
     (setq tce (getpoint "\n Укажите центр окружности, ограничивающей узел: "))
      (princ "\n Радиус окружности: ")
      (command "_circle" tce pause)
       (setq okr (entget (entlast))
             rokr (cdr(assoc 40 okr))
             tvn (getpoint tce "\n Укажите точку начала выноски: "))
       (command "_line" tce tvn "")
       (command "_lengthen" "_del" (- rokr) tce "")
     (setq priv (getvar "osmode"))
     (setvar "osmode" 0)
       (setq tvr  (polar tvn 0 llen)
             tvl  (polar tvn pi llen)
             ttr0 (polar tvn 0 (* 0.5 llen))
             ttr  (polar ttr0 (* 0.5 pi) 4)
             ttl0 (polar tvn pi (* 0.5 llen))
             ttl  (polar ttl0 (* 0.5 pi) 4)
             tpr  (polar ttr (* 1.5 pi) 7)
             tpl  (polar ttl (* 1.5 pi)7)
             ugr  (angle tce tvn))
    (if
    (and (> ugr 0) (<= ugr (* pi 0.5)))
            (command "_line" tvn tvr "")
    );if
    (if
    (and (> ugr (* pi 0.5)) (<= ugr pi))
            (command "_line" tvn tvl ""))
    (if
    (and (> ugr pi) (<= ugr (* 1.5 pi)))
            (command "_line" tvn tvl "")
    );if
    (if
    (and (> ugr (* 1.5 pi)) (<= ugr (* 2 pi)))
    (command "_line" tvn tvr "")
    );if
    (if
    (and (> ugr 0) (<= ugr (* pi 0.5)))
    (progn
    (command "_text" "_m" ttr 5 "0" txt1)
    (command "_text" "_m" tpr 3.5 "0" txt2)
    );progn
    );if
    (if
    (and (> ugr (* pi 0.5)) (<= ugr pi))
    (progn
    (command "_text" "_m" ttl 5 "0" txt1)
    (command "_text" "_m" tpl 3.5 "0" txt2)
    );progn
    );if
    (if
    (and (> ugr pi) (<= ugr (* pi 1.5)))
    (progn
    (command "_text" "_m" ttl 5 "0" txt1)
    (command "_text" "_m" tpl 3.5 "0" txt2)
    );progn
    );if
    (if (and (> ugr (* pi 1.5)) (<= ugr (* 2 pi)))
    (progn
    (command "_text" "_m" ttr 5 "0" txt1)
    (command "_text" "_m" tpr 3.5 "0" txt2)
    );progn
    );if
(setvar "osmode" priv)
(princ)
)

(command "_leader" pause pause "" "" "_n")

(apply '(lambda    ()
      (setvar "cmdecho" 0)
      (command "_leader" pause pause "" "" "_n")
    )
       '()
)