[olga87]

Здравствуйте Уважаемые программисты!

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

[name02]

В строках 102-119 добавил изменение координаты точки вставки в зависимости от расположения выноски: xy.lsp

Код:

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

 (defun trap1 (errmsg)
  (setq *error* temperr)
  (setvar "clayer" clay)
  ; (command "_ucs" "_p")
  (princ)
) ;_ end defun

(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"))
                               ">: "
                       ) ;_ end strcat
              ) ;_ end getreal
  ) ;_ end setq
  (if (null sztxt)
    (setq sztxt (getvar "TEXTSIZE"))
    (setvar "TEXTSIZE" sztxt)
  ) ;_ end if

  (defun _addleader (up-string low-string start-point end-point / lead_obj ann_obj point-list dx minp maxp new_pt
                    )
    (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))
                                    ) ;_ end vla-get-activespace
                             ) ;_ end zerop
                             (= :vlax-false
                                (vla-get-mspace
                                  (vla-get-activedocument (vlax-get-acad-object))
                                ) ;_ end vla-get-mspace
                             ) ;_ end =
                        ) ;_ end and
                      (vla-get-paperspace
                        (vla-get-activedocument (vlax-get-acad-object))
                      ) ;_ end vla-get-paperspace
                      (vla-get-modelspace
                        (vla-get-activedocument (vlax-get-acad-object))
                      ) ;_ end vla-get-modelspace
                    ) ;_ end if
                    (vlax-3d-point end-point)
                    0
                    (if (/= low-string "")
                      (strcat up-string "\\P" low-string)
                      up-string
                    ) ;_ end if
                  ) ;_ end vla-addmtext
    ) ;_ end setq


    (if (vlax-property-available-p ann_obj 'BackgroundFill)
        (vla-put-BackgroundFill ann_obj :vlax-true)
    ) ;_ end if
    (setq lead_obj (vla-addleader
                     (if (and (zerop (vla-get-activespace
                                       (vla-get-activedocument (vlax-get-acad-object))
                                     ) ;_ end vla-get-activespace
                              ) ;_ end zerop
                              (= :vlax-false
                                 (vla-get-mspace
                                   (vla-get-activedocument (vlax-get-acad-object))
                                 ) ;_ end vla-get-mspace
                              ) ;_ end =
                         ) ;_ end and
                       (vla-get-paperspace
                         (vla-get-activedocument (vlax-get-acad-object))
                       ) ;_ end vla-get-paperspace
                       (vla-get-modelspace
                         (vla-get-activedocument (vlax-get-acad-object))
                       ) ;_ end vla-get-modelspace
                     ) ;_ end if
                     (vlax-make-variant
                       (vlax-safearray-fill
                         (vlax-make-safearray
                           vlax-vbdouble
                           (cons 0 (1- (length point-list)))
                         ) ;_ end vlax-make-safearray
                         point-list
                       ) ;_ end vlax-safearray-fill
                     ) ;_ end vlax-make-variant
                     ann_obj
                     acLineNoArrow
                   ) ;_ end of vla-AddLeader
    ) ;_ end of setq

    (vla-GetBoundingBox ann_obj 'minp 'maxp)
    (setq dx (- (car (vlax-safearray->list maxp))
                (car (vlax-safearray->list minp))
             ) ;_ end -
    ) ;_ end setq


    (cond
      ((> (car end-point) (car start-point))
       (vla-put-attachmentpoint
         ann_obj
         acAttachmentPointMiddleLeft
       ) ;_ end vla-put-attachmentpoint
       (vla-put-insertionpoint ann_obj (vlax-3d-point end-point))
      )
      (T
       (vla-put-attachmentpoint
         ann_obj
         acAttachmentPointMiddleLeft
       ) ;_ end vla-put-attachmentpoint
       (setq new_pt (append (list (- (car end-point) dx)) (cdr end-point)))
       (vla-put-insertionpoint ann_obj (vlax-3d-point new_pt))

      ) ;_ end progn
    ) ;_ end cond

    (vla-put-verticaltextposition lead_obj acOutside)

    (vla-put-coordinate lead_obj 1 (vlax-3d-point end-point))

    lead_obj
  ) ;_ end defun

  (vl-load-com)
  (princ "\nLUPREC value = ")
  (princ (getvar "LUPREC"))
  (princ "  TEXTSIZE value = ")
  (princ (getvar "TEXTSIZE"))

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

    (_addleader
      (strcat "X="
              (vl-string-translate "." "," (rtos (nth 0 p1) 2))
      ) ;_ end strcat
      (strcat "Y="
              (vl-string-translate "." "," (rtos (nth 1 p1) 2))
      ) ;_ end strcat
      (trans pt1 1 0)
      (trans p2 1 0)
    ) ;_ end _addleader
  ) ;_ end progn

  (setq ssldr (entlast))
  (vla-put-scalefactor
    (vlax-ename->vla-object ssldr)
    (* 0.2 (getvar "TEXTSIZE"))
  ) ;_ end vla-put-scalefactor
  (command "_explode" ssldr)
  ; (command "_ucs" "_p")
  (princ)
) ;_ end defun
(princ "\nЗапуск команды XY")
(princ)

[olga87]

Спасибо большое!