Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
naturooo

Up dim, text, block chuẩn theo Viewport

Các bài được khuyến nghị

Trước khi in làm cái cho đỡ quên up :D

;;===============SUPER UP DIM, UP TEXT THEO VIEWPORT=======================================
(defun c:SUP( / oldCmdEcho listVPorts itemVPort ss ssl temp ed old new )
(vl-load-com)
(setq oldCmdEcho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq currentLayout (getvar "ctab"))
(setvar "CTAB" "Model")
(command "_.ucs" "w");Ve lai Model va dat lai UCS ve World
(foreach lay (layoutlist) (setvar "CTAB" lay)

(if (/= (getvar "CTAB") "Model")
 (progn
  (command "zoom" "all")
  (setq listVPorts (vl-sort (vports) '(lambda(v1 v2) (< (car v1) (car v2)))))
  (if (> (length listVPorts) 1)
   (progn
    (command "_MSPACE")
    (foreach itemVPort (cdr listVPorts)
     (setvar "CVPORT" (car itemVPort))
      ; (vpsel "W")
      (setq ent (vlax-vla-object->ename
                    (vla-get-activepviewport
                      (vla-get-activedocument (vlax-get-acad-object)))))
      (setq cvscale (vla-get-customscale (vlax-ename->vla-object ent)))
      (setvar "dimscale" (/ 1 cvscale))
      (setq cvscale (strcat "D" (rtos (/ 1 cvscale) 2 0)))
      (if (not (tblsearch "DIMSTYLE" cvscale))
      (command "-DIMSTYLE" "s" cvscale)
      (command "-DIMSTYLE" "r" cvscale) )
      (setq SCALE (getvar "dimscale"))
      ; (command "DIM1" "UP" "P" "")
      (vpsel "W")
      (c:UP)
    )
    (command "_PSPACE")
   )
   (prompt "\nThere are no viewports defined in this Layout!")
  )
 )
 (prompt "\nThis routine works only in Layout!")
)
);END foreach
(setvar "CMDECHO" oldCmdEcho)
(setvar "CTAB" currentLayout)
(princ)
)
;=====================================================================================
;https://lispbox.wordpress.com/2015/05/05/selecting-objects-within-viewport-and-copy-it-to-clipboard-by-selecting-a-ps-viewport/
;;; vpsel.lsp
; By Jimmy Bergmark
; Copyright (C) 1997-2006 JTB World, All Rights Reserved
; Website: http://www.jtbworld.com (http://www.jtbworld.com)
; E-mail: info@jtbworld.com
; 2000-04-14 - First release
; Tested on AutoCAD 2000
; DESCRIPTION
; Select all visible objects in selected or active paperspace viewport Works transparently when in modelspace and for polygonal viewports too
; Example1: ERASE ALL R 'VPC >>> Erase all in model except what is visible
; Example2: (command "erase" "all" "r" (c:vpc) "")
; Example3: VPC ERASE >>> VPC is run previous the command and the objects are also in previous selection set
; c:vpc - select all visible objects with crossing in viewport
; c:vpw - select all visible objects with window in viewport
; Phai dua UCS ve World ******************************************************************************************************************************************
(defun vpsel (typ / ad ss ent vpno ok vpbl vpur msbl msur msul mslr pl nlist x n)
 (vl-load-com)
 (setq ok t)
 (if (= (getvar "tilemode") 0)
  (progn
   (setq ad (vla-get-activedocument (vlax-get-acad-object)))
   (if (= (getvar "cvport") 1)
    (if (and (= (getvar "cmdactive") 0) (/= (setq ss (ssget ":E:S" '((0 . "VIEWPORT")))) nil))
     (progn
      (setq ent (ssname ss 0))
      (setq vpno (dxf 69 (entget ent)))
      (vla-Display (vla-get-activepviewport ad) :vlax-true)
      (vla-put-mspace ad :vlax-true)
      (setvar "cvport" vpno))
     (progn
      (setq ok nil)
      (princ)))
  (setq ent (vlax-vla-object->ename (vla-get-activepviewport ad))))
(if (and ok (/= 1 (logand 1 (dxf 90 (setq ed (entget ent))))))
(progn
(if (= (vla-get-clipped (vlax-ename->vla-object ent)) :vlax-false)
(progn
(vla-getboundingbox
(vla-get-activepviewport ad) 'vpbl 'vpur)
(setq msbl (trans (vlax-safearray->list vpbl) 3 2))
(setq msur (trans (vlax-safearray->list vpur) 3 2))
(setq msul (list (car msbl) (cadr msur)))
(setq mslr (list (car msur) (cadr msbl)))
(setq ss1
(ssget (strcat typ "P") (list msbl msul msur mslr))))
(progn
(setq pl (entget (dxf 340 (entget ent))))
(setq nlist nil)
(foreach x pl
(if (eq 10 (car x))
(setq nlist (cons (trans (cdr x) 3 2) nlist))))
(setq ss1 (ssget (strcat typ "P") nlist))))
(sssetfirst nil ss1)
(if ss1
(setq n (sslength ss1))
(setq n 0))
(princ n)
(princ " found ")
(if (and ss1 (= (getvar "cmdactive") 1))
ss1
(princ)))
(princ)))
(princ)))
;=============================================================================================

https://www.youtube.com/watch?v=ywKjGk7k8lo

  • Like 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay
Đăng nhập để thực hiện theo  

×