Тема: Простановка выноски в любой ПСК

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

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

Подскажите пожалуйста как исправить это код, чтобы не смещался МТекст выноски?
Пояснение некорректной работы лиспа на прикрепленной картинке.

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



(defun trap1 (errmsg)
  (setq *error* temperr)
  (setvar "clayer" clay)
  (princ)
)

(defun C:strxy ( / sztxt p1 pt1 p2 gs up_txt dn_txt)
  (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 "")
  )

  (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)
   )

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

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

  (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Укажите точку для считывания координат: "))
    (setq pt1 p1)
    (setq p2 (getpoint pt1 "\nУкажите размещение полки с текстом: "))

    (setq gs 100 ;шаг сетки
          up_txt (gstr p1 gs 'y)
          dn_txt (gstr p1 gs 'x))

    (_addleader
      (strcat up_txt)
      (strcat dn_txt)
      (trans pt1 1 0)
      (trans p2 1 0))
  )

  (setq ssldr (entlast))
  (vla-put-scalefactor
    (vlax-ename->vla-object ssldr)
    (* 0.2 (getvar "TEXTSIZE"))
  )

((lambda ( / rot vla_lead l_pt vla_anno)
    (setq
        rot (atan (/ (cadr (getvar "UCSXDIR")) (car (getvar "UCSXDIR"))))
        vla_lead (vlax-ename->vla-object (entlast))
        l_pt (vlax-get vla_lead 'Coordinates)
        vla_anno (vlax-get vla_lead 'Annotation)
    )

    (mapcar
        '(lambda (x)
            (vlax-invoke x 'Rotate (list (car l_pt) (cadr l_pt) (caddr l_pt)) rot)
        )
        (list vla_lead vla_anno)
    )
))

  (command "_explode" ssldr)
  (princ)
)

;Функция вычисления координат вида: "0A+50"
(defun gstr (p1 gs xw / getel tpart bstep btail stxt)
    (if (= xw 'x) (setq getel 'car tpart "Б+") (setq getel 'cadr tpart "А+"))
      (setq bstep (fix (/ ((eval getel) p1) gs)))
    (setq btail (- ((eval getel) p1) (* bstep gs)))
    (setq stxt (strcat (itoa bstep) tpart (vl-string-translate "." "," (rtos btail 2))))
    (princ stxt)
)

Post's attachments

Безымянный.png 10.21 Кб, файл не был скачан. 

You don't have the permssions to download the attachments of this post.