Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » AutoCAD VBA/LISP

Модерирует : ShIvADeSt

 Версия для печати • ПодписатьсяДобавить в закладки
На первую страницук этому сообщениюк последнему сообщению

Открыть новую тему     Написать ответ в эту тему

Anton T

Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Уже исправлена

Код:
(defun rtd (a) (* a (/ 180 pi)))         ;  radians to degrees
 
(defun getarc (/ no_arc e0 e1)
(setq no_arc T)
(while no_arc
  (if (setq e0 (entsel "\nSelect arc: "))
    (if (= (cdr (assoc 0 (setq e1 (entget (car e0))))) "ARC")
      (setq no_arc nil)
      (princ (strcat (cdr (assoc 0 e1)) ", Not an arc."))
    )                                    ;  end IF
    (princ " No object found.")
  )                                      ;  end IF
)                                        ;  end WHILE
(setq c1 (cdr (assoc 10 e1))             ;  center point
      r1 (cdr (assoc 40 e1))             ;  radius
      a0 (cdr (assoc 50 e1))             ;  start arc angle
      a1 (cdr (assoc 51 e1))             ;  end arc angle
      i1 (if (> a1 a0)                   ;  included angle
           (- a1 a0)
           (+ a1 (- (* pi 2) a0))
         )                               ;  end IF
      p1 (osnap (cadr e0) "_end")        ;  start point pick
      p2 (polar c1 a1 r1)                ;  end point arc
)                                        ;  end SETQ
)                                        ;  end DEFUN
 
(defun getset (/ h1 t1 n1 a2 _ce _hl _bm)
(setq h1                                 ;  check current text style height
  (if (zerop (cdr (assoc 40 (tblsearch "style" (getvar "textstyle")))))
         (getdist p1 "\nHeight: ")       ;  text height
         nil                             ;  height defined by STYLE
  )                                      ;  end IF
      t1 (getstring T "\nText: ")        ;  text string
      n1 1                               ;  counter
      a2 (/ i1 (1- (strlen t1)))         ;  angle increment
)                                        ;  end SETQ
(if (< (distance p1 p2) 1.0E-8)          ;  clockwise?
  (setq o1 '                           ;  clockwise
  (setq o1 '+                            ;  counter-clockwise
        a1 a0
  )                                      ;  end SETQ
)                                        ;  end IF
(setq _ce (getvar "cmdecho"))
(setq _hl (getvar "highlight"))
(setq _bm (getvar "blipmode"))
(setvar "cmdecho" 0)                     ;  suppress command echo
(setvar "highlight" 0)                   ;  suppress hightlighting
(setvar "blipmode" 0)                    ;  suppress blips
(repeat (strlen t1)                      ;  for each character
  (command "_text" "_c" "_none" p1)      ;  TEXT command
  (if h1 (command h1))
  (command ((eval o1) (rtd a1) 90) (substr t1 n1 1))
  (setq a1 ((eval o1) a1 a2)             ;  increment angle
        n1 (1+ n1)                       ;  increment counter
        p1 (polar c1 a1 r1)              ;  increment text point
  )                                      ;  end SETQ
)                                        ;  end REPEAT
(setvar "cmdecho" _ce)                   ;  enable command echo
(setvar "highlight" _hl)                 ;  enable hightlighting
(setvar "blipmode" _bm)                  ;  enable blips
)                                        ;  end DEFUN
 
(defun c:atext()
(princ "\n  *** Draws text on arcs ***") ;  banner
(getarc)                                 ;  get the arc
(getset)                                 ;  get the settings and draw text
(prin1)                                  ;  quiet exit
)
 

Всего записей: 325 | Зарегистр. 12-04-2006 | Отправлено: 16:16 29-06-2007
Открыть новую тему     Написать ответ в эту тему

На первую страницук этому сообщениюк последнему сообщению

Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » AutoCAD VBA/LISP


Реклама на форуме Ru.Board.

Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
Modified by Ru.B0ard
© Ru.B0ard 2000-2024

BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

Рейтинг.ru