Логотип сайта поддержки пользователей САПРО сайте поддержки пользователей САПР Translate to:

Получение масштаба видового экрана в активном или выбраном видовом экране

Назад к списку функций
;;; Получить Viewport Scale в активном или выбранном видовом экране
;;; Поддерживает видовые экраны с отсеченными границами
;;; Проверено на AutoCAD 2000
(defun c:getvpscale (/ ss ent)
(defun printscale (/  data cvsize cvhgt)
  (setq cvscale (vla-get-customscale (vlax-ename->vla-object ent)))
  (princ "\nPS:MS == ")
  (cond
    ((> cvscale 1)
     (princ (rtos cvscale 2))
     (princ ":1")
    )
    (T
     (princ "1:")
     (princ (rtos (/ 1 cvscale) 2))
    )
  )
)
  (vl-load-com)
  (if (= (getvar "tilemode") 0)
    (if (= (getvar "cvport") 1)
      (if (/= (setq ss (ssget ":E:S" '((0 . "VIEWPORT")))) nil)
        (if (/= 1 (logand 1 (cdr (assoc 90 (entget (setq ent (ssname ss 0)))))))
          (printscale)
          (princ "\n Command not allowed in perspective view.")
        )
        (princ " No viewport found.")
      )
      (progn
        (setq ent (vlax-vla-object->ename
                    (vla-get-activepviewport
                      (vla-get-activedocument (vlax-get-acad-object)))))
        (if (/= 1 (logand 1 (cdr (assoc 90 (entget ent)))))
          (printscale)
          (princ "\n Command not allowed in perspective view.")
        )
      )
    )
    (princ "\n Command not allowed unless TILEMODE is set to 0.") 
  )
  (princ)
)

;;; Возвращает масштаб видового экрана, если разрешено. Иначе - nil
(defun getvpscale1 (/ ss ent)
  (vl-load-com)
  (if (= (getvar "tilemode") 0)
    (if (= (getvar "cvport") 1)
      (if (/= (setq ss (ssget ":E:S" '((0 . "VIEWPORT")))) nil)
        (if (/= 1 (logand 1 (cdr (assoc 90 (entget (setq ent (ssname ss 0)))))))
          (vla-get-customscale (vlax-ename->vla-object ent))
        )
      )
      (progn
        (setq ent (vlax-vla-object->ename
                    (vla-get-activepviewport
                      (vla-get-activedocument (vlax-get-acad-object)))))
        (if (/= 1 (logand 1 (cdr (assoc 90 (entget ent)))))
          (vla-get-customscale (vlax-ename->vla-object ent))
        )
      )
    )
  )
)

;;;  Возвращает масштаб видового экрана, если разрешено. Иначе - nil
;;;  не поддерживает выды-перспективы
(defun getvpscale2 (/ ss vpno vpsc)
  (if (= (getvar "tilemode") 0)
    (if (= (getvar "cvport") 1)
      (if (/= (setq ss (ssget ":E:S" '((0 . "VIEWPORT")))) nil)
        (progn
          (setq vpno (cdr (assoc 69 (entget (ssname ss 0)))))
          (command "_.mspace")
          (setvar "cvport" vpno)
          (setq vpsc (caddr (trans '(0 0 1) 2 3)))
          (command "_.pspace")
          vpsc
        )
      )
      (caddr (trans '(0 0 1) 2 3))
    )
  )
)

;;; возвращает масштаб видового экрана
;;; не поддерживает видовые экраны с отсеченными границами
;;; виды-перспективы также не поддерживаются

(defun getvpscale3(/ vpno vpsc)
  (setq vpno (cdr (assoc 69 (entget (car (entsel))))))
  (command "mspace")
  (setvar "cvport" vpno)
  (setq vpsc (caddr (trans '(0 0 1) 2 3)))
  (command "pspace")
  vpsc
)

;;; возвратить масштаб в активный видовой экран
;|
(caddr (trans '(0 0 1) 2 3))
|;



Copyright © Сайт поддержки пользователей САПР by Victor Tkachenko