Позиция в кружке в Acad'e

Позиция в кружке в Acad'e · 03.09.2005, 17:42

:!: Нужен лисп для проставления позиций в кружочках

Насколько я знаю Автокад умеет отрисовывать прямоугольник вокруг текста размера и выноски, а вот кружки не ставит :?

Кто сталкивался, подскажите, плиз

Torino · 03.09.2005, 18:40

В СПДС ГрафиКС это есть.

Vova · 03.09.2005, 18:43

А если по-простому? Сделай блок в виде кружочка и в нем атрибут.

Геннадий aka PG · 03.09.2005, 22:43

Запуск (c:ball 1) или (c:ball 0) начальная точка точечка или стрелка (точнее не помню)
Номера позиций изменяются сами 1,2,3....
Входит в сборник cadhlp

Код:

[Выделить все]

;---------------------------------------------------------------------------
;---------- BALL.LSP    by Pospelov G.
;
;------------ Копия для AutoCAD 2000  BALL.LSP -----------------------------
;  Программа для рисования осевой линии с окружностью на конце
; Размер точки, кружка и высота текста в нем определяются
; значениями переменных. Если значение DIMASZ равно нулю,
; точка нарисована не будет. Если для текущей гарнитуры шрифта задана
; фиксированная высота, ее значение будет использована при отрисовке
; текста внутри кружка.
; Нажатие клавиши <RETURN> или пробела в ответ на запрос программы
; "От точки:" воспринимается как указание прекратить выполнение команды.
;---------------------------------------------------------------------------
;error function
(defun *error* (msg)
(setq msg "Function Abort itself")
(princ)
(princ msg)
(princ)
)
;
;---------------------------------------------------------------------------
;------------------> BALL <-------------------------------------------------
(defun c:ball ( tipus / a b c d h l r txt ce bm osm)

; 	 a : Начальная точка выноски
; 	 b : Центр кружка
;	 c : Конечная точка выноски / ветвь стрелки
;	 d : Диаметр точки / ветвь стрелки
;	 h : Высота текста
;	 r : Радиус окружности

; Сохранение значений  и установка системных переменных
  (setq ce (getvar "CMDECHO" )
        bm (getvar "BLIPMODE")
       osm (getvar "OSMODE")
  )
  (setq a T )
  (setvar "CMDECHO" 0)
  (setvar "BLIPMODE" 0)
  (if (= tipus 0) (setvar "OSMODE" 0)
                  (setvar "OSMODE" 512)
  )  

; Проверка - имеет ли текущая гарнитура шрифта фиксированную высоту
  (setq ts (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE")))))
  (if (zerop ts)

; Установка диаметра кружка соответственно высоте текста
      (setq r (* (getvar "DIMSCALE") (getvar "DIMTXT") 1.5)
            h (* (getvar "DIMSCALE") (getvar "DIMTXT"))
      )

; Установка радиуса кружка соответственно высоте текста
      (setq r (* ts 1.5))
      )

; Запрос начальной точки
;   / Hажатие клавиши <RETURN> или пробела прерывает
;                                              выполнение функции/
 (setq a (getpoint "\nНачинать от : ")) 
 (while a
    ; Запрос центра кружка (нулевой ответ не воспринимается)
       (initget 1)
       (setq b (getpoint a "\nУкажите центр кружка:  "))
       (if (null oldtxt) (setq oldtxt "n.1"))
       (prompt (strcat "\nТекст <" oldtxt ">: "))
       (setq txt (getstring))
       (if (= txt "") (setq txt oldtxt))

;     (setvar "BLIPMODE" 0)
; Отрисовывает точку, если значение DIMASZ не равно нулю
      (if (= tipus 0)
         (progn
; Установка диаметра точки в 0.025 раз меньшим
;     величины размерной стрелки
          (setq d (* (getvar "DIMSCALE") (getvar "DIMASZ") 0.025))
          (if (> d 0) (command "CIRCLE" a d ))
          )
         (progn
;  Определение стрелки для выноски
           (setq c (polar a (+ (angle a b) 0.2)
                           (* (getvar "DIMSCALE") (getvar "DIMASZ") )
                  )
                d (polar a (- (angle a b) 0.2)
                           (* (getvar "DIMSCALE") (getvar "DIMASZ") )
                  )
           )
           (command "SOLID" a c d c "")
         )
      ) ; Close  if (= tipus 0)
; Вычисление точки пересечения оси и кружка
      (setq c (polar a
                      (angle a b)
                      (- (distance a b) r)
               )
       )
       (command "line" a c "") ;   Рисует ось
       (command "circle" b r) ;   Рисует кружок

;   Рисует текст (здесь проверяется, была ли
; установлена фиксированная высота гарнитуры текста)
       (if (zerop ts)
           (command "TEXT" "M" b h 0 txt)
           (command "TEXT" "M" b pause 0 txt)
       )
     (setq oldtxt (itoa (1+ (atoi txt)))
            a T )

     (setq a (getpoint "\nСледующая точка <Enter - отмена>: "))
   
 )  ;close while

; восстановление значений системных переменных
 (setvar "BLIPMODE" bm)
 (setvar "CMDECHO" ce)
 (setvar "OSMODE" osm)
 (princ)
)
;;;-------------------------------------------------------------------

zamtmn · 03.09.2005, 23:37

тулпаковская DSTP_ANNOSURR ставит вокруг текста и кружочки тоже...

Georg · 04.09.2005, 01:03

Геннадий aka PG, спасибо за код, подрихтовал – заработало как надо было. [sm200]

1. В исходном коде при фиксированной высоте текста вместо позиции давал «0»
2. Заменил точку-кружок на кольцо
3. Определил для текста поз. cтиль отличный от текущего для возможность дать поз. больший размер.
4. Уменьшил диаметр окружности.

За аккуратность смены кода не ручаюсь, поскольку о ЛИСПе знаю только понаслышке. :shock:

А почему такой хитрый вызов команды (c:ball 0)? :?

Всем спасибо, проблема решилась [sm159]

Код:

[Выделить все]

;--------------------------------------------------------------------------- 
;---------- BALL.LSP    by Pospelov G. 
; 
;------------ Копия для AutoCAD 2000  BALL.LSP ----------------------------- 
;  Программа для рисования осевой линии с окружностью на конце 
; Размер точки, кружка и высота текста в нем определяются 
; значениями переменных. Если значение DIMASZ равно нулю, 
; точка нарисована не будет. Если для текущей гарнитуры шрифта задана 
; фиксированная высота, ее значение будет использована при отрисовке 
; текста внутри кружка. 
; Нажатие клавиши <RETURN> или пробела в ответ на запрос программы 
; "От точки:" воспринимается как указание прекратить выполнение команды. 
; Для работы программы необходимо создать стиль текта (LED) с нужной высотой текста
;--------------------------------------------------------------------------- 
;error function 
(defun *error* (msg) 
(setq msg "Function Abort itself") 
(princ) 
(princ msg) 
(princ) 
) 
; 
;--------------------------------------------------------------------------- 
;------------------> BALL <------------------------------------------------- 
(defun c:ball ( tipus / a b c d h l r txt ce bm osm) 

;     a : Начальная точка выноски 
;     b : Центр кружка 
;    c : Конечная точка выноски / ветвь стрелки 
;    d : Диаметр точки / ветвь стрелки 
;    h : Высота текста 
;    r : Радиус окружности 

; Сохранение значений  и установка системных переменных 
  (setq ce (getvar "CMDECHO" ) 
        bm (getvar "BLIPMODE") 
       osm (getvar "OSMODE")
        tm (getvar "TEXTSTYLE")
  ) 
  (setq a T ) 
  (setvar "CMDECHO" 1) 
  (setvar "BLIPMODE" 0)
  (setvar "TEXTSTYLE" "led")
  (if (= tipus 0) (setvar "OSMODE" 0) 
                  (setvar "OSMODE" 512) 
  )  

; Проверка - имеет ли текущая гарнитура шрифта фиксированную высоту 
  (setq ts (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))) 
  (if (zerop ts) 

; Установка диаметра кружка соответственно высоте текста 
      (setq r (* (getvar "DIMSCALE") (getvar "TEXTSIZE") 1.35) 
            h (* 1.4 (getvar "DIMTXT")) 
      ) 

; Установка радиуса кружка соответственно высоте текста 
      (setq r (* ts 1.33)) 
      ) 

; Запрос начальной точки 
;   / Hажатие клавиши <RETURN> или пробела прерывает 
;                                              выполнение функции/ 
 (setq a (getpoint "\nНачинать от : ")) 
 (while a 
    ; Запрос центра кружка (нулевой ответ не воспринимается) 
       (initget 1) 
       (setq b (getpoint a "\nУкажите центр кружка:  ")) 
       (if (null oldtxt) (setq oldtxt "n.1")) 
       (prompt (strcat "\nТекст <" oldtxt ">: ")) 
       (setq txt (getstring)) 
       (if (= txt "") (setq txt oldtxt)) 

;     (setvar "BLIPMODE" 0) 
; Отрисовывает точку, если значение DIMASZ не равно нулю 
      (if (= tipus 0) 
         (progn 
; Установка диаметра точки в 0.025 раз меньшим 
;     величины размерной стрелки 
          (setq d (* (getvar "DIMSCALE") (getvar "DIMASZ") 0.025)) 
          (if (> d 0) (command "donut" 0 1 a  "")) 
          ) 
         (progn 
;  Определение стрелки для выноски 
           (setq c (polar a (+ (angle a b) 0.2) 
                           (* (getvar "DIMSCALE") (getvar "DIMASZ") ) 
                  ) 
                d (polar a (- (angle a b) 0.2) 
                           (* (getvar "DIMSCALE") (getvar "DIMASZ") ) 
                  ) 
           ) 
           (command "SOLID" a c d c "") 
         ) 
      ) ; Close  if (= tipus 0) 
; Вычисление точки пересечения оси и кружка 
      (setq c (polar a 
                      (angle a b) 
                      (- (distance a b) r) 
               ) 
       ) 
       (command "line" a c "") ;   Рисует ось 
       (command "circle" b r) ;   Рисует кружок 

;   Рисует текст (здесь проверяется, была ли 
; установлена фиксированная высота гарнитуры текста) 
       (if (zerop ts) 
           (command "TEXT" "M" b h 0 txt) 
           (command "TEXT" "S" "led" "M" b 0 txt) 
       ) 
     (setq oldtxt (itoa (1+ (atoi txt))) 
            a T ) 

     (setq a (getpoint "\nСледующая точка <Enter - отмена>: ")) 
    
 )  ;close while 

; восстановление значений системных переменных 
 (setvar "BLIPMODE" bm) 
 (setvar "CMDECHO" ce) 
 (setvar "OSMODE" osm)
 (setvar "textstyle" tm) 
 (princ) 
) 
;;;-------------------------------------------------------------------

Геннадий aka PG · 04.09.2005, 10:42

Если вызов команды с аргументом "1", товместо точки в начале линии рисуется стрелка (показать на шов, линию) Раньше (сейчас не знаю) была такая разновидность указания на поверхность и шов (линию)

Alan · 05.09.2005, 11:32

Полностью согласен с Vova Сб Сен 03, 2005 16:43
ЛИСП здесь абсолютно не нужен. Блока с атрибутом (двумя, если нужна ссылка на лист) вполне достаточно.

Perezz!! · 05.09.2005, 13:31

В меню Express -> Text -> Automatic text numbering.
С коммандной строки tcircle.
Всё, естественно, при установленных Express Tools.

Геннадий aka PG · 05.09.2005, 14:57

2 Alan
-А автоматическая последовательная нумерация?
-Стрелка или точка в начальной точке?
-По указанию расположение начальной точки и кружка
Разве такое все лишнее?

2 Perezz
Не совсем про то....

Alan · 05.09.2005, 21:37

>Геннадий aka PG
Georg пишет: "Нужен лисп для проставления позиций в кружочках" и это вся постановка задачи. Для какого раздела проектирования и т.д. можно только догадываться.
В любом, а в таком особенно, случае повторяющиеся графические изображения необходимо оформлять в блок с атрибутами. Ну а потом обрамлять вставку блока ЛИСПом: в указание точек; пересчет NN позиций и т.п.
Вот посмотри на ответ тебе Georg"а : пп.2,3,4 - достаточно изменить геометрию блока и ЛИСП не трогать.
Тем более, что позиции потом придется считать для спецификации. Но это всё по принципу буквоедства. Хочется всегда видить что-то большое и чистое! Мытого слона...?

Стас · 05.09.2005, 21:51

Как вариант:
http://www.cadforyou.spb.ru/download_main.shtml

Геннадий aka PG · 05.09.2005, 22:34

> Alan
Человек попросил ЛИСП, и не надо ему втюхивать блок с атрибутом !

Лентяй · 06.09.2005, 06:21

Цитата:

Геннадий aka PG:Человек попросил ЛИСП, и не надо ему втюхивать блок с атрибутом !

Увы, товарищ не понимает(С), что оптимальный вариант - это ЛИСП, вставляющий блоки с атрибутами. ассациировные для удобства со стрелками. Причем тип стрелки можно сделать переключающимся. Ловите таковую лиспу. ибо аз есмь добр днесь

Код:

[Выделить все]

;Вставка выносок с автоматически же проставляемыми номерами позиций в кружке. 
;Масштаб вставки определяется автоматически.
;(с)Лентяй 2005
;Блок SPN004 - круг с атрибутом, определен в библиотеке файлов.
(defun *error* (msg)
  (if (= msg "Function cancelled") (princ msg)(princ));if
  (mapcar '(lambda (m n) (setvar m n))'("ATTREQ" "ORTHOMODE" "OSMODE") (list ar om sm))
);*error*
;
(defun C:KNC ( / csp sm om cpt pt opt blk cp x0 x1 y0 y1 sc kw)
  (setq adoc (vla-get-ActiveDocument (vlax-get-acad-object))
          bks (vla-get-blocks adoc)
          sm (getvar "OSMODE")
          om (getvar "ORTHOMODE")
          ar (getvar "ATTREQ"));setq
  (mapcar '(lambda (m n) (setvar m n)) '("ATTREQ" "ORTHOMODE" "OSMODE") '(0 0 512))
  (setq n (getint "\nInput Start Number: <1>"))
  (if (null n) (setq n 1))
  (setq dn (getint "\nInput Offset: <1>"))
  (if (null dn) (setq dn 1))
  (prompt "\nSelect Object to Call Out and Number: ")
  (initget "Yes Now") (setq kw (getkword "\n Arrows [Yes/No]: ? <Yes>"))
    (if (null kw) (setq kw "Yes"))
  (setq ent (entsel))
  (while ent
    (setq cpt (cadr ent) pt (getpoint "\nSelect Call Out Location: ?")
;Опредение масштаба вставки блока и стрелки
          csp (vlax-invoke adoc "ObjectIDtoObject"
                (vla-get-ownerID (vlax-ename->vla-object (car ent)))));setq
    (if (= (vla-get-name csp) "*Paper_Space")(setq sc 1.0)
      (progn (if (= (vla-get-ActiveSpace adoc) 0)
          (setq vp (vla-get-ActivePViewport adoc)
                sc (/ 1 vla-get-CustomScale vp));setq
          (progn (vlax-for vp (vla-get-paperSpace adoc)
              (if (= (vla-get-ObjectName vp) "AcDbViewport")(progn
	      (setq cp (cdr (assoc 12 (entget (vlax-vla-object->ename vp))))
		    x0 (- (car cp) (/ (vla-get-Width vp) (vla-get-CustomScale vp) 2))
		    x1 (+ (car cp) (/ (vla-get-Width vp) (vla-get-CustomScale vp) 2))
		    y0 (- (cadr cp) (/ (vla-get-Height vp) (vla-get-CustomScale vp) 2))
		    y1 (+ (cadr cp) (/ (vla-get-Height vp) (vla-get-CustomScale vp) 2)));setq
              (if (and (<= x0 (car cpt) x1) (<= y0 (cadr cpt) y1))
                (setq sc (/ 1 (vla-get-CustomScale vp))))));if
            );vlax-for
            (if (null sc) (setq sc (getreal "Enter scale factor: "))));progn
        ));progn
    );if
    (setq l (if (< (car cpt) (car pt)) t nil) bn (strcat "SPN004" (if l "L" "R")))
;Проверка, существует ли блок нумерации и его создание, есле нет
    (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list bks bn)))
      (progn (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list bks "SPN004")))
               (vla-delete (vla-insertBlock csp (vlax-3d-point pt)
                           "C:\\IES\\Design Center\\SPN004.dwg" 1 1 1 0 "X")));if
        (vlax-for el (vla-item bks "SPN004")
          (if (= (vla-get-Objectname el) "AcDbCircle") (setq d (vla-get-diameter el))))
        (setq bk (vla-item bks "SPN004") opt (vlax-get bk 'origin))
        (vla-addLine bk (vlax-3d-point (cons (- (car opt) (if l d (* -1 d))) (cdr opt)))
          (vlax-3d-point (cons (- (car opt) (* 0.5 (if l d (* -1 d)))) (cdr opt))))
        (vla-put-name bk bn)));if
;Вставка блока и его автонумерация
    (setq blk (vla-insertblock csp (vlax-3d-point pt) bn sc sc sc 0))
    (vla-put-TextString (car (vlax-safearray->list (vlax-variant-value (vla-getattributes blk)))) (itoa n))
    (setq n (+ n dn))
    (vla-getBoundingBox blk 'mn 'mx)
    (vla-put-ScaleFactor (vla-addLeader csp (vlax-make-variant (vlax-safearray-fill
      (vlax-make-safearray vlax-vbDouble '(0 . 5))
            (append cpt (subst (car (vlax-safearray->list (if l mn mx))) (car pt) pt))));variant
               blk (if (= kw "Yes") acLineWithArrow acLineNoArrow)) sc);leader
    (prompt "\nSelect Next Object to Call Out or <ENTER> to Quit: ")
    (setq ent (entsel))
  );while
  (mapcar '(lambda (m n) (setvar m n))'("ATTREQ" "ORTHOMODE" "OSMODE") (list ar om sm))
);end

А вот блок SPN004
[ATTACH]1125991697.dwg[/ATTACH]

03.09.2005, 17:42		#1
Позиция в кружке в Acad'e Georg Design Kiev Регистрация: 27.10.2004 Сообщений: 57 :!: Нужен лисп для проставления позиций в кружочках Насколько я знаю Автокад умеет отрисовывать прямоугольник вокруг текста размера и выноски, а вот кружки не ставит :? Кто сталкивался, подскажите, плиз
Просмотров: 5768