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

Простановка выноски в любой ПСК · 15.11.2023, 07:11

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

Есть код ниже, который проставляет координаты (точнее берет точку для считывания координат) в любой ПСК и строит выноску-полку горизонтальной всегда в МСК.
Подскажите пожалуйста, как исправить код, чтобы и полка строилась в этой любой ПСК?
(*наверное нужно в конце кода добавить поворот выноски на угол относительно МСК, Поворот с базовой точкой "start-point")

Код:

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

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

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

name02 · 15.11.2023, 08:16

Исправил твой код (см. строки 152-162) - держи STRXY.lsp:

Код:

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

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

(defun C:strxy (/ sztxt p1 pt1 p2 gs up_txt dn_txt Xproj rot_in_rad)
  (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
                    )
    (if (not low-string)
      (setq low-string "")
    ) ;_ end 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 vla-addleader
    ) ;_ end 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 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Укажите размещение полки с текстом: "))

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

    (_addleader
      (strcat up_txt)
      (strcat dn_txt)
      (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

  ;проекция оси Х ПСК на ось Х МСК
  (setq Xproj (car (getvar "UCSXDIR")))  
  ;вычисление угла поворота оси Х ПСК относительно оси Х МСК (в радианах)
  (setq rot_in_rad ((atan (SQRT (- 1 (* Xproj Xproj))) Xproj)))

;;;  устанавливаем свойству ПОВОРОТ новое значение 
  (vlax-put-property ssldr 'rotation rot_in_rad)
  
  (command "_explode" ssldr)
  (princ)
) ;_ end defun

  ;Функция вычисления координат вида: "0A+50"
(defun gstr (p1 gs xw / getel tpart bstep btail stxt)
  (if (= xw 'x)
    (setq getel 'car
          tpart "Б+"
    ) ;_ end setq
    (setq getel 'cadr
          tpart "А+"
    ) ;_ end setq
  ) ;_ end if
  (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))
             ) ;_ end strcat
  ) ;_ end setq
  (princ stxt)
) ;_ end defun

Суть такая: что после создания мультивыноски мы определяем угол поворота текущей системы координат относительно мировой и устанавливаем свойство "поворот" мультивыноски на найденное значение

olga87 · 15.11.2023, 10:18

Этот код в Автокаде работает (но без расчленения в конце).

Извините, что сразу не отметила что лисп нужен для Нанокада - код выше не работает в Нанокад.
Если добавить в конце:

Код:

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

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

то работает, но МТекст съезжает: видимо сама выноска поворачивается с МТекстом. (Может быть до поворота нужно линию выноски от МТекста открепить или разрушить всю выноску до поворота)
Можете подсказать как это исправить?

name02 · 15.11.2023, 10:43

Цитата:

Сообщение от olga87

Этот код в Автокаде работает (но без расчленения в конце).
Извините, что сразу не отметила что лисп нужен для Нанокада - этот код не работает.
Если добавить в конце: .....
то работает, но МТекст съезжает.

Исходный код работает, но расчленения мультивыноски не происходит или вообще не работает?

olga87 · 15.11.2023, 10:52

Исходный код (STRXY.lsp) не работает в Нанокад, точнее работает но полка все равно по МСК.

Если добавить

Код:

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

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

то остается проблема с МТекстом (как на рисунке

Нажмите на изображение для увеличения
Название: Безымянный.png
Просмотров: 22
Размер: 10.2 Кб
ID: 260019

).

Возможно можно добавить далее процедуру - у выноски ручку полки соединить с точкой выравнивания МТекст:

Нажмите на изображение для увеличения
Название: Безымянный2.png
Просмотров: 19
Размер: 15.9 Кб
ID: 260020

name02 · 15.11.2023, 11:37

С Lisp под NanoCAD я помочь не смогу
Что по тому, что ты прислала.
1 Сделай Z-координату у второй точки равной Z от первой (они должны быть одинаковыми). Попробуй указывать точки с разными Z - увидишь разницу

Код:

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

     (setq p2 (getpoint pt1 "\nУкажите размещение полки с текстом: "))
    (setq p2 (list (car p2) (cadr p2) (caddr p1)))

2 Затем в другом участке кода надо будет сделать так:

Код:

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

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

Но опять-таки, я все в Автокаде это делаю. Как в Нанокаде будет - не знаю

olga87 · 15.11.2023, 14:39

Подскажите пожалуйста как в коде ниже в функции "((lambda..." сделать следующее:

1) Расчленив выноску (без МТекста) - это делает "(command "_explode" ssldr)"
2) Повернуть и выноску (после расчленения это 2 отрезка) и МТекст на угол ПСК (чтобы текст и 1 отрезок были горизонтально), т.е. для "(vlax-invoke x 'Rotate (list (car l_pt) (cadr l_pt) (caddr l_pt)) rot)" нужно знать 1ю указанную точку, а значит ее нужно запомнить до расчленения выноски и использовать для поворота.

Нажмите на изображение для увеличения
Название: Безымянный.png
Просмотров: 9
Размер: 7.2 Кб
ID: 260027

Код:

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

(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"))
  )
  (command "_explode" ssldr)

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

name02 · 15.11.2023, 15:02

Слушай, а Автокаде если мультивыноску если создавать стандартно, то она по умолчанию ориентированна вдоль оси Х текущей системы координат
Может и в Нанокаде также?
Если да, то можно попробовать сделать так:
1 Определяешь точку вставки выноски pt_1
2 Вызываешь стандартную команду (command "_mleader" pt_1)
3 Вставляешь окончательно мультивыноску
4 Пихаешь в нее нужные координаты точки pt_1

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Лисп простой пользовательской выноски	Сет	LISP	72	28.03.2016 12:01
В чертеже внезапно все выноски слились в одну - почему?	Xara	AutoCAD	3	13.08.2014 10:49
Соответствуют ли нормам подобные выноски (см. вложения)	PKB1178	Организация проектирования и оформление документации	48	14.04.2014 12:13
Добавление в выноску значения, и подсчет длинны отрезка на который опирается линия выноски	antiponf	Программирование	15	04.04.2012 20:43
Многоуровневая парковка (нужен любой проект для обсчета себестоимости)	serebro	Поиск литературы, чертежей, моделей и прочих материалов	1	14.12.2011 01:01