[olga87]

Здравствуйте Уважаемые программисты!
С помощью кода ниже (lisp, autocad 2007 2D) создается объект Автокада "Выноска" с координатами выбранной точки. Код работает в любой ПСК.
Подскажите пожалуйста как код ниже исправить, чтобы полка и текст выноски в повернутой ПСК располагались всегда горизонтально и направлены были вправо. Ниже на рисунке прикладываю пояснение.
Заранее спасибо!

Код:

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

(defun C:XY ( / p1 p2)
(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 "\nLUPREC value = ")(princ (getvar "LUPREC"))
  (princ "  TEXTSIZE value = ")(princ (getvar "TEXTSIZE"))
(while
  (and
    (setq p1 (getpoint "\nPoint <exit>: "))
    (setq p2 (getpoint p1 "\nDirection <exit>: "))
    )
    (_addleader
    (strcat "X=" (rtos (nth 0 p1) 2))
    (strcat "Y=" (rtos (nth 1 p1) 2))
    (trans p1 1 0)(trans p2 1 0))(princ)))
(princ "\nType XY in command line")

----- добавлено через ~22 ч. -----
Код исправила:

Код:

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

(defun trap1 (errmsg)
         (setq *error* temperr)
         (setvar "clayer" clay)
         (command "_ucs" "_p")
(princ)
)
(defun C:XY ( / sztxt p1 pt1 p2)

         (command "cmdecho" 0)
         (setq clay (getvar "clayer"))
         (setq temperr *error*)
         (setq *error* trap1)

(setq sztxt (getreal (strcat "\nВведите высоту текста <" (rtos (getvar "TEXTSIZE")) ">: ")))
(if (null sztxt)
  (setq sztxt (getvar "TEXTSIZE"))
  (setvar "TEXTSIZE" sztxt)
)

(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 "\nLUPREC value = ")(princ (getvar "LUPREC"))
  (princ "  TEXTSIZE value = ")(princ (getvar "TEXTSIZE"))

  (progn
    (setq p1 (getpoint "\nУкажите точку для считывания координат: "))
    (command "_ucs" "_w")
    (setq pt1 (getpoint "\nУкажите ту же точку для считывания координат еще раз: "))
    (setq p2 (getpoint pt1 "\nУкажите размещение полки с текстом: "))

    (_addleader
    (strcat "X=" (vl-string-translate "." "," (rtos (nth 0 p1) 2)))
    (strcat "Y=" (vl-string-translate "." "," (rtos (nth 1 p1) 2)))
    (trans pt1 1 0)(trans p2 1 0))
  )
  (command "_ucs" "_p")
  (princ)
)
(princ "\nЗапуск команды XY")
(princ)

Подскажите пожалуйста, как исправить этот код, чтобы сразу после создания выноски с текстом, линию выноски (leader) расчленить.
Спасибо!