Здравствуйте Уважаемые программисты!
Код ниже (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)
)