[Джек]

Всем привет!!!
Вот я написал маленькую простенькую програмульку.
Данная программка делает выноску , значение выноски берется – имя слоя в котором находится примитив.

Код:

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

(defun c:vinoka+sloy1 ()
    (setq znachenie_sloya (cdr (assoc 8 (entget (car (entsel))))))
   (vl-cmdf "_.text" pause 350 0 znachenie_sloya)
  ;;Установка отрезка для выноски
   (setq pt2 (getvar "lastpoint"))
    (setq pt3 (polar pt2 -90.0 150))
  (setq pt4 (polar pt3 0.0 1120))
  (setq pt1 (getpoint "\nУкажите начальную точку выноски:" pt3))
    (setq pt5 (if (> (distance pt1 pt3) (distance pt1 pt4)) pt4 pt3))    
  ;;Установка отрезка для выноски
    (command "_.line"   pt1  pt5  "" )
  (command "_.line"   pt3 pt4  "" )
    (princ)
  )

Но вот проблемка нет визуализации, т.е. куда ставится значение выноски и как узнать длину текстового примитива для создания горизонтального отрезка выноски?

За ранее спасибо!

[Кулик Алексей aka kpblc]

А чем не устраивает обычный _leader или _qleader с внесением в MText поля?

[Джек]

Не подойдет - потому что я сначало указываю примитив и из примитива берется значение имени слоя

[Лентяй]

Тогда надо писать реактор под qleader? который бы вставлял имя слоя в соотв. строку текста. Я бы написал, да лениво мне...

[Кулик Алексей aka kpblc]

А, черт, видео не лезет (в запакованном виде 2,7 метра). Короче, лежит http://depositfiles.com/files/3331180. Возможно, потребуется кодек (грузить с http://www.techsmith.com/download/codecs.asp)

[VVA]

На основе XY отсюда. Без реактора, но с выноской

Код:

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

;На основе http://dwg.ru/f/showthread.php?t=14385
;Для http://dwg.ru/f/showthread.php?p=206373
;;; Leader + Layer
(defun C:L+L ( / p1 p2)
;;На основе _kpblc-draw-leader
(defun _addleader (up-string low-string   start-point end-point /   lead_obj ann_obj point-list)
  (if (not low-string)(setq low-string "")) ;_ end of if
  (setq point-list (apply 'append (list start-point end-point)))
  (setq   ann_obj    (vla-addmtext
         (if (and (zerop (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object))))
           (= :vlax-false (vla-get-mspace (vla-get-activedocument (vlax-get-acad-object)))))
    (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
    (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
         (vlax-3d-point end-point)
         0
         (if (/= low-string "")(strcat up-string "\\P" low-string) up-string)))
  (if (vlax-property-available-p ann_obj 'BackgroundFill)
  (vla-put-BackgroundFill ann_obj :vlax-true))
  (setq lead_obj (vla-addleader
        (if (and (zerop (vla-get-activespace (vla-get-activedocument (vlax-get-acad-object))))
           (= :vlax-false (vla-get-mspace (vla-get-activedocument (vlax-get-acad-object)))))
    (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object)))
    (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
        (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble
             (cons 0 (1- (length point-list)))) point-list)) ann_obj  acLineNoArrow ) ;_ end of vla-AddLeader
   ) ;_ end of setq
  (vla-put-attachmentpoint ann_obj
    (+ 4 (if (> (car end-point) (car start-point))
       0  2) ;_ end of if
       (if (/= low-string "")
           0 3) ;_ end of if
       ) ;_ end of +
    ) ;_ end of vla-put-AttachmentPoint
  (vla-put-insertionpoint ann_obj (vlax-3d-point end-point))
  (vla-put-verticaltextposition lead_obj acOutside)
  (vla-put-coordinate lead_obj 1 (vlax-3d-point end-point)) lead_obj)
  (vl-load-com)
 
  (princ "  TEXTSIZE value = ")(princ (getvar "TEXTSIZE"))
(while
  (and
    (setq en (car (entsel "\nSelect object <exit>: ")))
    (setq fld (strcat
                "%<\\AcObjProp Object(%<\\_ObjId "
                (vl-princ-to-string
                  (vla-get-objectid (vlax-ename->vla-object en))
                  ) ;_ vl-princ-to-string
                ">%).Layer \\f \"%tc3\">%"
                ) ;_ strcat
          ) ;_ setq
    (setq p1 (getpoint "\nPoint <exit>: "))
    (setq p2 (getpoint p1 "\nDirection <exit>: "))
    )
    (_addleader fld nil
    (trans p1 1 0)(trans p2 1 0))(princ)))
(princ "\nType L+L in command line")

[VVA]

>Кулик Алексей aka kpblc

А чем не устраивает обычный _leader или _qleader с внесением в MText поля?

Я думаю скоростью. Проще взять _kpblc-draw-leader и в качестве up-string передать строчку с полем

[Джек]

VVA
Спасибо за лисп, но все рано не видно куда ставится текст!
Да и мне не хотелось применять команды выноски , можно просто ограничется текстом и двумя отрезками.
Или нет такой возможности, то применить (если можно) прямоугольником подсветки перед вставкой.

[Кулик Алексей aka kpblc]

(grvecs) и вперед Для вычисления координат текста можно воспользоваться (textbox). Дальше мне сейчас просто шансов нет расписывать (

[vk]

Полагаю, алгоритм должен быть примерно такой:
- кликаем в примитив, получаем из него данные, запоминаем точку клика;
- отрисовываем ._text и запоминаем его ename;
- вычисляем длину текста (нужно для отрисовки полки);
- запускаем ._move и передаем ей как аргумент только что созданный текст, ждем завершения команды от пользователя (после размещения текста куда нада);
- вычисляем новое расположение текста, отрисовываем линии.

Если правильно понял задачу, должно получиться.

PS уже сто лет не писал на Лиспе.

[VVA]

Для визуализации предлагаю отказаться от _move, а использовать связку _.copybase _.pasteclip. Вот фрагментик, остальное допишешь

Код:

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

(if (setq en (car (entsel "\nВыберите объект <выход>: ")))
 (progn
  (setq txt (entmakex
      (list
        (cons 0 "TEXT")
        (cons 100 "AcDbEntity")
        (cons 100 "AcDbText")
        (cons 72 0)           ;_ выравнивание влево
        (cons 1 (cdr(assoc 8 (entget en))))
        ;(cons 7 style) ;_Текущий стиль
        ;(cons 8 layer) ;_Текущий слой
        (cons 10 '(0 0 0))
        (cons 11 '(0 0 0))
        (cons 40 (getvar "TEXTSIZE")) ;_Высота текста
        ) ;_ list
      ) ;_ entmakex
          )
  ;_ Копируем в буфер и обратно
  (setvar "cmdecho" 0)
  (princ "\n Укажите точку вставки текста:")
  (command "_.copybase" (trans '(0 0 0) 0 1) txt "" "_.erase" txt "" "_.pasteclip" "_non" pause)
  ;_ В txt примитив текста в pt точка вставки  
  (setq txt (entlast) pt (getvar "LASTPOINT"))
  (setq box (textbox (entget txt)))
  (setq txt_len (- (caadr box)(caar box)))
  (setq pt1 (polar pt (* 1.5 pi) 1)) ;_на 1 вниз от текста
  (setq pt2 (polar pt1 0 txt_len))
  (command "_.LINE" "_non" pt2 "_non" pt1 pause)(command)

  )
)

[Джек]

VVA, Спасибо огромное, все получилось!!!!!

[Джек]

VVA, а вот еще вопросец! Можно так же сделать два однострочных текста - две строки?
Например:
Опуск с отм. +11.000
на отм. +6.550, Ду 50

[VVA]

Какая разница сколько в буфер копировать

Код:

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

(setq txt1 (entmakex
      (list
        (cons 0 "TEXT")
        (cons 100 "AcDbEntity")
        (cons 100 "AcDbText")
        (cons 72 0)           ;_ выравнивание влево
        (cons 1 "%%uОпуск с отм. +11.000")
        ;(cons 7 style) ;_Текущий стиль
        ;(cons 8 layer) ;_Текущий слой
        (cons 10 '(0 0 0))
        (cons 11 '(0 0 0))
        (cons 40 3) ;_Высота текста 3
        ) ;_ list
      ) ;_ entmakex
          )
(setq txt2 (entmakex
      (list
        (cons 0 "TEXT")
        (cons 100 "AcDbEntity")
        (cons 100 "AcDbText")
        (cons 72 0)           ;_ выравнивание влево
        (cons 1 "на отм. +6.550, Ду 50")
        ;(cons 7 style) ;_Текущий стиль
        ;(cons 8 layer) ;_Текущий слой
        (cons 10 '(0 -5 0))
        (cons 11 '(0 -5 0))
        (cons 40 3) ;_Высота текста 3
        ) ;_ list
      ) ;_ entmakex
          )
(command "_.copybase" (trans '(0 0 0) 0 1) txt1 txt2 "" "_.erase" txt1 txt2 "" "_.pasteclip" "_non" pause)

[u77]

похожая тема
http://dwg.ru/f/printthread.php?t=6474&pp=1000

[CB]

И еще одна
http://www.caduser.ru/cgi-bin/f1/boa...30675cA&page=3