【矩阵运算】从布局空间复制图元至到模型空间

smartstar · 发表于 2015-8-14 16:14:34

本帖最后由 smartstar 于 2015-8-19 09:06 编辑

图片演示的是LEE MAC的“Modelspace to Paperspace”功能（附件是LEE MAC的程序文件），我想把此功能逆向操作，就拿LEE MAC的程序进行了修改，但用于水平有限，lisp矩阵运算一头雾水，所以只完成了一个半成品。只有当视口没有旋转的时候能够正常运行，当视口旋转了，拷贝到模型空间的图元就不在想要的位置上了，贴出来让高手们帮忙修改一下。代码如下：

(defun c:ps2ms ( / *error* ang doc enx idx lst mat nor scl sel )
(vl-load-com)
(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(LM:startundo (LM:acdoc))
(cond
( (= 1 (getvar 'tilemode))
(prompt "\nCommand only available in Paperspace.")
)
( (= 1 (getvar 'cvport))
(prompt "\nPlease activate a viewport.")
)
( (setq enx (entget (ssname (ssget "_X" (list '(0 . "VIEWPORT") (cons 69 (getvar 'cvport)))) 0)))
(command "PSPACE")
(setq sel (ssget (list (cons 410 (getvar 'ctab)))))
(repeat (setq idx (sslength sel))
(setq lst (cons (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) lst));图元名称表
)
(setq ang (- (cdr (assoc 51 enx))));视图扭转角度
(setq nor (cdr (assoc 16 enx)));16观察方向矢量（在WCS中）17观察目标点（在WCS中）10 中心点（在WCS中） 12视口中心（在DCS中）
(setq scl (/ (cdr (assoc 45 enx)) (cdr (assoc 41 enx)))) ;ZOOM XP 比例
(setq pt (cdr (assoc 10 enx)))
(setq mat
(vlax-tmatrix
(append
(mapcar '(lambda ( a b ) (append a (list b)))
(setq mat
(mxm
(mapcar (function (lambda ( v ) (vxs (trans v nor 0 t) scl)))
'(
(1.0 0.0 0.0)
(0.0 1.0 0.0)
(0.0 0.0 1.0)
)
)
(list
(list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
)
)
(mapcar '+;视口不旋转没有问题
(mxv mat (mapcar '- (cdr (assoc 10 enx))))
(cdr (assoc 12 enx))
;(vxs (cdr (assoc 17 enx)) (- scl))
;(vxs (cdr (assoc 17 enx)) scl)
(cdr (assoc 17 enx))
)
)
'((0.0 0.0 0.0 1.0))
)
)
)
(foreach obj
(vlax-invoke (setq doc (vla-get-activedocument (vlax-get-acad-object))) 'copyobjects lst
(vla-get-block
(vla-item
(vla-get-layouts doc)
"Model"
)
)
)
(vla-transformby obj mat)
)
)
)
(LM:endundo (LM:acdoc))
(princ)
)
;; Matrix Transpose - Doug Wilson
;; Args: m - nxn matrix
;;矩阵转置
(defun trp ( m )
(apply 'mapcar (cons 'list m))
)
;; Matrix x Matrix - Vladimir Nesterovsky
;; Args: m,n - nxn matrices
;;矩阵 × 矩阵
(defun mxm ( m n )
((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)
;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
;;矩阵 × 向量
(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
;; Vector x Scalar - Lee Mac
;; Args: v - vector in R^n, s - real scalar
;;向量 ×比例
(defun vxs ( v s )
(mapcar '(lambda ( n ) (* n s)) v)
)
;; Start Undo - Lee Mac
;; Opens an Undo Group.
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
;; End Undo - Lee Mac
;; Closes an Undo Group.
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;; Active Document - Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
;;----------------------------------------------------------------------;;

(defun c:ps2ms ( / *error* ang doc enx idx lst mat nor scl sel ) 
        (vl-load-com) 
        (defun *error* ( msg ) 
                (LM:endundo (LM:acdoc)) 
                (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) 
                        (princ (strcat "\nError: " msg)) 
                ) 
                (princ) 
        ) 
        
        (LM:startundo (LM:acdoc)) 
        (cond 
                (   (= 1 (getvar 'tilemode)) 
                        (prompt "\nCommand only available in Paperspace.") 
                ) 
                (   (= 1 (getvar 'cvport)) 
                        (prompt "\nPlease activate a viewport.") 
                ) 
                (   (setq enx (entget (ssname (ssget "_X" (list '(0 . "VIEWPORT") (cons 69 (getvar 'cvport)))) 0))) 
                        (command "PSPACE") 
                        (setq sel (ssget (list (cons 410 (getvar 'ctab))))) 
                        (repeat (setq idx (sslength sel)) 
                                (setq lst (cons (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) lst));图元名称表 
                        ) 
                        
                        
                        (setq ang (- (cdr (assoc 51 enx))));视图扭转角度 
                        (setq nor (cdr (assoc 16 enx)));16观察方向矢量（在WCS中）17观察目标点（在WCS中）10 中心点（在WCS中） 12视口中心（在DCS中） 
                        (setq scl (/ (cdr (assoc 45 enx)) (cdr (assoc 41 enx)))) ;ZOOM XP 比例 
                        (setq pt (cdr (assoc 10 enx))) 
                        (setq mat 
                                (vlax-tmatrix 
                                        (append 
                                                (mapcar '(lambda ( a b ) (append a (list b))) 
                                                        (setq mat 
                                                                (mxm 
                                                                        (mapcar (function (lambda ( v ) (vxs (trans v nor 0 t) scl))) 
                                                                                '( 
                                                                                        (1.0 0.0 0.0) 
                                                                                        (0.0 1.0 0.0) 
                                                                                        (0.0 0.0 1.0) 
                                                                                ) 
                                                                        ) 
                                                                        (list 
                                                                                (list (cos ang) (- (sin ang)) 0.0) 
                                                                                (list (sin ang)    (cos ang)  0.0) 
                                                                                '(0.0 0.0 1.0) 
                                                                        ) 
                                                                        
                                                                ) 
                                                        ) 
                                                        (mapcar '+;视口不旋转没有问题 
                                                                (mxv mat (mapcar '- (cdr (assoc 10 enx)))) 
                                                                (cdr (assoc 12 enx)) 
                                                                ;(vxs (cdr (assoc 17 enx)) (- scl)) 
                                                                ;(vxs (cdr (assoc 17 enx))  scl) 
                                                                (cdr (assoc 17 enx)) 
                                                        ) 
                                                ) 
                                                '((0.0 0.0 0.0 1.0)) 
                                        ) 
                                ) 
                        ) 
                        (foreach obj 
                                (vlax-invoke (setq doc (vla-get-activedocument (vlax-get-acad-object))) 'copyobjects lst 
                                        (vla-get-block 
                                                (vla-item 
                                                        (vla-get-layouts doc) 
                                                        "Model" 
                                                ) 
                                        ) 
                                ) 
                                (vla-transformby obj mat) 
                        ) 
                ) 
        ) 
        (LM:endundo (LM:acdoc)) 
        (princ) 
) 
 
;; Matrix Transpose  -  Doug Wilson 
;; Args: m - nxn matrix 
;;矩阵转置 
(defun trp ( m ) 
        (apply 'mapcar (cons 'list m)) 
) 
 
;; Matrix x Matrix  -  Vladimir Nesterovsky 
;; Args: m,n - nxn matrices 
;;矩阵 × 矩阵 
(defun mxm ( m n ) 
        ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n)) 
) 
 
;; Matrix x Vector  -  Vladimir Nesterovsky 
;; Args: m - nxn matrix, v - vector in R^n 
;;矩阵 × 向量 
(defun mxv ( m v ) 
        (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m) 
) 
 
;; Vector x Scalar  -  Lee Mac 
;; Args: v - vector in R^n, s - real scalar 
;;向量 ×比例 
(defun vxs ( v s ) 
        (mapcar '(lambda ( n ) (* n s)) v) 
) 
 
;; Start Undo  -  Lee Mac 
;; Opens an Undo Group. 
(defun LM:startundo ( doc ) 
        (LM:endundo doc) 
        (vla-startundomark doc) 
) 
 
;; End Undo  -  Lee Mac 
;; Closes an Undo Group. 
(defun LM:endundo ( doc ) 
        (while (= 8 (logand 8 (getvar 'undoctl))) 
                (vla-endundomark doc) 
        ) 
) 
 
;; Active Document  -  Lee Mac 
;; Returns the VLA Active Document Object 
(defun LM:acdoc nil 
        (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) 
        (LM:acdoc) 
) 
 
;;----------------------------------------------------------------------;;

以下是我找的一下资料：

;; WCS2PCS (gile)
;; Translates a point WCS coordinates to the PaperSpace CS according to
;; the specified Viewport
;;
;; (WCS2PCS pt vp) is the same as (trans (trans pt 0 2) 2 3) when vp is active
;;
;; Arguments
;; pt : a point
;; vp : the viewport (ename or vla-object)
(defun WCS2PCS (pt vp / elst ang nor scl mat)
(vl-load-com)
(and (= (type vp) 'VLA-OBJECT)
(setq vp (vlax-vla-object->ename vp))
)
(setq pt (trans pt 0 0)
elst (entget vp)
ang (cdr (assoc 51 elst))
nor (cdr (assoc 16 elst))
scl (/ (cdr (assoc 41 elst)) (cdr (assoc 45 elst)))
mat (mxm
(list (list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(mapcar (function (lambda (v) (trans v nor 0 T)))
'((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
)
)
)
(mapcar '+
(vxs (mxv mat (mapcar '- pt (cdr (assoc 17 elst)))) scl)
(vxs (cdr (assoc 12 elst)) (- scl))
(cdr (assoc 10 elst))
)
)
;; PCS2WCS (gile)
;; Translates a point PaperSpace coordinates to WCS coordinates
;; according to the specified viewport
;;
;; (PCS2WCS pt vp) is the same as (trans (trans pt 3 2) 2 0) when vp is active
;;
;; Arguments
;; pt : a point
;; vp : the viewport (ename or vla-object)
(defun PCS2WCS (pt vp / ang nor scl mat)
(vl-load-com)
(and (= (type vp) 'VLA-OBJECT)
(setq vp (vlax-vla-object->ename vp))
)
(setq pt (trans pt 0 0)
elst (entget vp)
ang (- (cdr (assoc 51 elst)))
nor (cdr (assoc 16 elst))
scl (/ (cdr (assoc 45 elst)) (cdr (assoc 41 elst)))
mat (mxm
(mapcar (function (lambda (v) (trans v 0 nor T)))
'((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0))
)
(list (list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
)
)
(mapcar '+
(mxv mat
(mapcar '+
(vxs pt scl)
(vxs (cdr (assoc 10 elst)) (- scl))
(cdr (assoc 12 elst))
)
)
(cdr (assoc 17 elst))
)
)
;; VXS Multiply a vector by a scalar
;;
;; Arguments : a vector and a real
(defun vxs (v s) (mapcar (function (lambda (x) (* x s))) v))
;; VXV (gile)
;; Returns the dot product of two vectors (real)
;;
;; Arguments : two vectors
;; return : a real number
(defun vxv (v1 v2) (apply '+ (mapcar '* v1 v2)))
;; TRP
;; transposes a matrix -Doug Wilson-
;;
;; Argument : a matrix
;; return : a matrix
(defun trp (m) (apply 'mapcar (cons 'list m)))
;; MXV
;; Applies a transformation matrix to a vector -Vladimir Nesterovsky-
;;
;; Arguments : une matrice et un vecteur
;; return : a vector
(defun mxv (m v)
(mapcar '(lambda (r) (vxv r v)) m)
)
;; MXM
;; Multiplies (combinates) two matrices -Vladimir Nesterovsky-
;;
;; Arguments : deux matrices
;; return : a matrix
(defun mxm (m q)
(mapcar '(lambda (r) (mxv (trp q) r)) m)
)

;; WCS2PCS (gile) 
;; Translates a point WCS coordinates to the PaperSpace CS according to 
;; the specified Viewport 
;; 
;; (WCS2PCS pt vp) is the same as (trans (trans pt 0 2) 2 3) when vp is active 
;; 
;; Arguments 
;; pt : a point 
;; vp : the viewport (ename or vla-object) 
 
(defun WCS2PCS (pt vp / elst ang nor scl mat) 
  (vl-load-com) 
  (and (= (type vp) 'VLA-OBJECT) 
       (setq vp (vlax-vla-object->ename vp)) 
  ) 
  (setq pt   (trans pt 0 0) 
        elst (entget vp) 
        ang  (cdr (assoc 51 elst)) 
        nor  (cdr (assoc 16 elst)) 
        scl  (/ (cdr (assoc 41 elst)) (cdr (assoc 45 elst))) 
        mat  (mxm 
               (list (list (cos ang) (- (sin ang)) 0.0) 
                     (list (sin ang) (cos ang) 0.0) 
                     '(0.0 0.0 1.0) 
               ) 
               (mapcar (function (lambda (v) (trans v nor 0 T))) 
                       '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)) 
               ) 
             ) 
  ) 
  (mapcar '+ 
          (vxs (mxv mat (mapcar '- pt (cdr (assoc 17 elst)))) scl) 
          (vxs (cdr (assoc 12 elst)) (- scl)) 
          (cdr (assoc 10 elst)) 
  ) 
) 
 
;; PCS2WCS (gile) 
;; Translates a point PaperSpace coordinates to WCS coordinates 
;; according to the specified viewport 
;; 
;; (PCS2WCS pt vp) is the same as (trans (trans pt 3 2) 2 0) when vp is active 
;; 
;; Arguments 
;; pt : a point 
;; vp : the viewport (ename or vla-object) 
 
(defun PCS2WCS (pt vp / ang nor scl mat) 
  (vl-load-com) 
  (and (= (type vp) 'VLA-OBJECT) 
       (setq vp (vlax-vla-object->ename vp)) 
  ) 
  (setq pt   (trans pt 0 0) 
        elst (entget vp) 
        ang  (- (cdr (assoc 51 elst))) 
        nor  (cdr (assoc 16 elst)) 
        scl  (/ (cdr (assoc 45 elst)) (cdr (assoc 41 elst))) 
        mat  (mxm 
               (mapcar (function (lambda (v) (trans v 0 nor T))) 
                       '((1.0 0.0 0.0) (0.0 1.0 0.0) (0.0 0.0 1.0)) 
               ) 
               (list (list (cos ang) (- (sin ang)) 0.0) 
                     (list (sin ang) (cos ang) 0.0) 
                     '(0.0 0.0 1.0) 
               ) 
             ) 
  ) 
  (mapcar '+ 
          (mxv mat 
               (mapcar '+ 
                       (vxs pt scl) 
                       (vxs (cdr (assoc 10 elst)) (- scl)) 
                       (cdr (assoc 12 elst)) 
               ) 
          ) 
          (cdr (assoc 17 elst)) 
  ) 
) 
 
;; VXS Multiply a vector by a scalar 
;; 
;; Arguments : a vector and a real 
 
(defun vxs (v s) (mapcar (function (lambda (x) (* x s))) v)) 
 
;; VXV (gile) 
;; Returns the dot product of two vectors (real) 
;; 
;; Arguments : two vectors 
;; return : a real number 
 
(defun vxv (v1 v2) (apply '+ (mapcar '* v1 v2))) 
 
;; TRP 
;; transposes a matrix -Doug Wilson- 
;; 
;; Argument : a matrix 
;; return : a matrix 
 
(defun trp (m) (apply 'mapcar (cons 'list m))) 
 
;; MXV 
;; Applies a transformation matrix to a vector  -Vladimir Nesterovsky- 
;; 
;; Arguments : une matrice et un vecteur 
;; return : a vector 
 
(defun mxv (m v) 
  (mapcar '(lambda (r) (vxv r v)) m) 
) 
 
;; MXM 
;; Multiplies (combinates) two matrices -Vladimir Nesterovsky- 
;; 
;; Arguments : deux matrices 
;; return : a matrix 
 
(defun mxm (m q) 
  (mapcar '(lambda (r) (mxv (trp q) r)) m) 
)

edata · 发表于 2015-8-14 16:20:15

ET不是自带这个功能？

smartstar · 发表于 2015-8-14 16:24:55

edata 发表于 2015-8-14 16:20
ET不是自带这个功能？

没有装ET

edata · 发表于 2015-8-14 16:33:18

你试试这个

(princ "\n \n \ninitializing: ")
(defun c:c2p ()
(to-paperspace 1)
)
(defun c:m2p ()
(to-paperspace 0)
)
(defun to-paperspace (qj / q@ qq ql q& q1 q# q0 q$ qo q| q% q?J qjj q@j qqj
qlj q&j q1j q#j q0j q$j qoj
)
(setq q@ nil
qq nil
q& nil
q1 nil
q# nil
q0 nil
q$ nil
qo nil
q| nil
q% nil
q?J nil
qjj nil
q@j nil
qqj nil
qlj nil
q&j nil
q1j nil
q#j nil
q0j nil
q$j nil
qoj nil
)
(setq ql (getvar "cmdecho")
q@ (getvar "expert")
qq (getvar "osmode")
q& (getvar "cvport")
)
(setvar "cmdecho" 0)
(setvar "expert" 2)
(setvar "osmode" 0)
(command "undo" "m")
(defun dtr (q|j)
(/ (* q|j pi) 180.0)
)
(defun rtd (q%j)
(/ (* q%j 180.0) pi)
)
(if (= (getvar "tilemode") 1)
(princ "\n \n \n** 该命令不能在模型空间运行,请切换到图纸空间(布局) **")
(if (= (length (vports)) 1)
(princ "\n \n \n \n当前没有活动的视口.")
(progn
(setq q?@ *error*)
(defun *error* (qj@)
(cond
((or
(= qj@ "程序取消")
(= qj@ "控制台中断")
)
)
)
(sp2sp_reset)
)
(command "mspace")
(if (= qj 1)
(princ "\n \n选择需要复制(copy)到图纸空间的对象: \n ")
(princ "\n \n选择需要移动(move)到图纸空间的对象: \n ")
)
(setq q# (ssget))
(command "pspace")
(setq q@@ (getvar "ucsname"))
(command "ucs" "world")
(setq q$ (ssget "x" (list (cons 0 "viewport"))))
(if (/= q# nil)
(progn
(if (= qj 1)
(princ "\n \n正在复制. \n \n请等待...")
(princ "\n \n正在移动. \n \n请等待...")
)
(while (= q1 nil)
(setq qo (ssname q$ 0))
(setq q| (entget qo (quote ("acad"))))
(setq q% (cadr (assoc (quote -3) q|)))
(setq qjj (rtos (/ (cdr (assoc (quote 41) q|)) (cdr
(nth 7
q%
)
)
) 2 6
)
)
(if (= (cdr (assoc (quote 68) q|)) 2)
(setq q1 1)
)
(ssdel qo q$)
)
(setq qqj (cdr (assoc (quote 10) q|)))
(command "mspace")
(setq qq@ (getvar "ucsname"))
(command "ucs" "view")
(setq q0 (getvar "viewctr"))
(setvar "highlight" 0)
(if (= qj 1)
(command "block" "to-paperspace" q0 q# "" "oops")
(command "block" "to-paperspace" q0 q# "")
)
(if (= qq@ "")
(command "ucs" "world")
(command "ucs" "r" qq@)
)
(command "pspace")
(command "insert" "*to-paperspace" qqj qjj "0")
(if (= q@@ "")
(command "ucs" "world")
(command "ucs" "r" q@@)
)
(princ "\n \n \n ")
(princ "\n \n \n完成... ")
)
(progn
(princ "\n \n \n")
(alert "你没有选择对象!")
)
)
(if (= q& 1)
(command "pspace")
(command "mspace")
)
)
)
)
(setvar "expert" q@)
(setvar "cmdecho" ql)
(setvar "osmode" qq)
(setvar "highlight" 1)
(setq q@ nil
qq nil
q& nil
q1 nil
q# nil
q0 nil
q$ nil
qo nil
q| nil
q% nil
q?J nil
qjj nil
q@j nil
qqj nil
qlj nil
q&j nil
q1j nil
q#j nil
q0j nil
q$j nil
qoj nil
)
(princ)
)
(defun c:c2m ()
(to-modelspace 1)
)
(defun c:m2m ()
(to-modelspace 0)
)
(defun to-modelspace (qj / q@ qq ql q& q1 q# q0 q$ qo q| q% q?J qjj q@j qqj
qlj q&j q1j q#j q0j q$j qoj
)
(setq q@ nil
qq nil
q& nil
q1 nil
q# nil
q0 nil
q$ nil
qo nil
q| nil
q% nil
q?J nil
qjj nil
q@j nil
qqj nil
qlj nil
q&j nil
q1j nil
q#j nil
q0j nil
q$j nil
qoj nil
)
(setq ql (getvar "cmdecho")
q@ (getvar "expert")
qq (getvar "osmode")
q& (getvar "cvport")
)
(setvar "cmdecho" 0)
(setvar "expert" 2)
(setvar "osmode" 0)
(command "undo" "m")
(defun dtr (q|j)
(/ (* q|j pi) 180.0)
)
(defun rtd (q%j)
(/ (* q%j 180.0) pi)
)
(if (= (getvar "tilemode") 1)
(princ "\n \n \n** 该命令不能在模型空间运行,请切换到图纸空间(布局) **")
(if (= (length (vports)) 1)
(princ "\n \n \n \n当前没有活动的视口.")
(progn
(setq q?@ *error*)
(defun *error* (qj@)
(cond
((or
(= qj@ "程序取消")
(= qj@ "控制台中断")
)
)
)
(sp2sp_reset)
)
(command "pspace")
(if (= qj 1)
(princ "\n \n选择需要复制(Copy)到模型空间(视口)的对象: \n ")
(princ "\n \n选择需要移动(Move)到模型空间(视口)的对象: \n ")
)
(setq q# (ssget (quote ((-4 . "<not") (0 . "viewport")
(-4 . "not>")
)
)
)
)
(if (/= q# nil)
(progn
(command "mspace")
(if (> (length (vports)) 2)
(if (= qj 1)
(getpoint (strcat "\n \n \n发现" (itoa (- (length
(vports)
) 1
)
) " 个视口.\n \n请在需要复制到的视口内指定一点: "
)
)
(getpoint (strcat "\n \n \n发现" (itoa (- (length
(vports)
) 1
)
) " 个视口.\n \n请在需要移动到的视口内指定一点: "
)
)
)
)
(if (= qj 1)
(princ "\n \n正在复制. \n \n请等待...")
(princ "\n \n正在移动. \n \n请等待...")
)
(command "pspace")
(setq q$ (ssget "x" (list (cons 0 "viewport"))))
(while (= q1 nil)
(setq qo (ssname q$ 0))
(setq q| (entget qo (quote ("acad"))))
(setq q% (cadr (assoc (quote -3) q|)))
(setq qjj (rtos (/ (cdr (nth 7 q%)) (cdr (assoc
(quote 41)
q|
)
)
) 2 6
)
)
(if (= (cdr (assoc (quote 68) q|)) 2)
(setq q1 1)
)
(ssdel qo q$)
)
(setq qqj (cdr (assoc (quote 10) q|)))
(setq q@@ (getvar "ucsname"))
(command "ucs" "world")
(setvar "highlight" 0)
(if (= qj 1)
(command "block" "to-modelspace" qqj q# "" "oops")
(command "block" "to-modelspace" qqj q# "")
)
(if (= q@@ "")
(command "ucs" "world")
(command "ucs" "r" q@@)
)
(command "mspace")
(setq qq@ (getvar "ucsname"))
(command "ucs" "view")
(setq q0 (getvar "viewctr"))
(command "insert" "*to-modelspace" q0 qjj "0")
(if (= qq@ "")
(command "ucs" "world")
(command "ucs" "r" qq@)
)
(princ "\n \n \n ")
(princ "\n \n \n完成... ")
)
(progn
(princ "\n \n \n")
(alert "你没有选择对象!")
)
)
(if (= q& 1)
(command "pspace")
(command "mspace")
)
)
)
)
(setvar "expert" q@)
(setvar "cmdecho" ql)
(setvar "osmode" qq)
(setvar "highlight" 1)
(setq q@ nil
qq nil
q& nil
q1 nil
q# nil
q0 nil
q$ nil
qo nil
q| nil
q% nil
q?J nil
qjj nil
q@j nil
qqj nil
qlj nil
q&j nil
q1j nil
q#j nil
q0j nil
q$j nil
qoj nil
)
(princ)
)
(defun sp2sp_reset ()
(setq *error* q?@)
(princ "\n \n \n")
(if (= qq@)
(command "mspace" "ucs" "r" qq@)
)
(if (= q@@)
(command "pspace" "ucs" "r" q@@)
)
(if (= q& 1)
(command "pspace")
(command "mspace")
)
(setvar "expert" q@)
(setvar "cmdecho" ql)
(setvar "osmode" qq)
(setvar "highlight" 1)
(setq q@ nil
qq nil
ql nil
q& nil
q1 nil
q# nil
q0 nil
q$ nil
qo nil
q| nil
q% nil
q?J nil
qjj nil
q@j nil
qqj nil
qlj nil
q&j nil
q1j nil
q#j nil
q0j nil
q$j nil
qoj nil
)
(princ "\n \n \necs trapped the error \n")
(princ)
)
(princ "\n \n \nc2p = 复制到图纸空间 & m2p = 移动到图纸空间\nc2m = 复制到模型空间(视口) & m2m = 移动到模型空间(视口)")
(princ)

(princ "\n \n \ninitializing: ") 
(defun c:c2p () 
  (to-paperspace 1) 
) 
(defun c:m2p () 
  (to-paperspace 0) 
) 
(defun to-paperspace (qj / q@ qq ql q& q1 q# q0 q$ qo q| q% q?J qjj q@j qqj 
                         qlj q&j q1j q#j q0j q$j qoj 
                     ) 
  (setq q@ nil 
        qq nil 
        q& nil 
        q1 nil 
        q# nil 
        q0 nil 
        q$ nil 
        qo nil 
        q| nil 
        q% nil 
        q?J nil 
        qjj nil 
        q@j nil 
        qqj nil 
        qlj nil 
        q&j nil 
        q1j nil 
        q#j nil 
        q0j nil 
        q$j nil 
        qoj nil 
  ) 
  (setq ql (getvar "cmdecho") 
        q@ (getvar "expert") 
        qq (getvar "osmode") 
        q& (getvar "cvport") 
  ) 
  (setvar "cmdecho" 0) 
  (setvar "expert" 2) 
  (setvar "osmode" 0) 
  (command "undo" "m") 
  (defun dtr (q|j) 
    (/ (* q|j pi) 180.0) 
  ) 
  (defun rtd (q%j) 
    (/ (* q%j 180.0) pi) 
  )   
    (if (= (getvar "tilemode") 1) 
      (princ "\n \n \n** 该命令不能在模型空间运行,请切换到图纸空间(布局) **") 
      (if (= (length (vports)) 1) 
        (princ "\n \n \n \n当前没有活动的视口.") 
        (progn           
          (setq q?@ *error*) 
          (defun *error* (qj@) 
            (cond 
              ((or 
                 (= qj@ "程序取消") 
                 (= qj@ "控制台中断") 
               ) 
              ) 
            ) 
            (sp2sp_reset) 
          ) 
          (command "mspace") 
          (if (= qj 1) 
            (princ "\n \n选择需要复制(copy)到图纸空间的对象: \n ") 
            (princ "\n \n选择需要移动(move)到图纸空间的对象: \n ") 
          ) 
          (setq q# (ssget)) 
          (command "pspace") 
          (setq q@@ (getvar "ucsname")) 
          (command "ucs" "world") 
          (setq q$ (ssget "x" (list (cons 0 "viewport")))) 
          (if (/= q# nil) 
            (progn 
              (if (= qj 1) 
                (princ "\n \n正在复制. \n \n请等待...") 
                (princ "\n \n正在移动. \n \n请等待...") 
              ) 
              (while (= q1 nil) 
                (setq qo (ssname q$ 0)) 
                (setq q| (entget qo (quote ("acad")))) 
                (setq q% (cadr (assoc (quote -3) q|))) 
                (setq qjj (rtos (/ (cdr (assoc (quote 41) q|)) (cdr 
                                                                    (nth 7 
                                                                         q% 
                                                                    ) 
                                                               ) 
                                ) 2 6 
                          ) 
                ) 
                (if (= (cdr (assoc (quote 68) q|)) 2) 
                  (setq q1 1) 
                ) 
                (ssdel qo q$) 
              ) 
              (setq qqj (cdr (assoc (quote 10) q|))) 
              (command "mspace") 
              (setq qq@ (getvar "ucsname")) 
              (command "ucs" "view") 
              (setq q0 (getvar "viewctr")) 
              (setvar "highlight" 0) 
              (if (= qj 1) 
                (command "block" "to-paperspace" q0 q# "" "oops") 
                (command "block" "to-paperspace" q0 q# "") 
              ) 
              (if (= qq@ "") 
                (command "ucs" "world") 
                (command "ucs" "r" qq@) 
              ) 
              (command "pspace") 
              (command "insert" "*to-paperspace" qqj qjj "0") 
              (if (= q@@ "") 
                (command "ucs" "world") 
                (command "ucs" "r" q@@) 
              ) 
              (princ "\n \n \n ")              
              (princ "\n \n \n完成... ") 
            ) 
            (progn 
              (princ "\n \n \n") 
              (alert "你没有选择对象!") 
            ) 
          ) 
          (if (= q& 1) 
            (command "pspace") 
            (command "mspace") 
          ) 
        ) 
      ) 
    ) 
   
  (setvar "expert" q@) 
  (setvar "cmdecho" ql) 
  (setvar "osmode" qq) 
  (setvar "highlight" 1) 
  (setq q@ nil 
        qq nil 
        q& nil 
        q1 nil 
        q# nil 
        q0 nil 
        q$ nil 
        qo nil 
        q| nil 
        q% nil 
        q?J nil 
        qjj nil 
        q@j nil 
        qqj nil 
        qlj nil 
        q&j nil 
        q1j nil 
        q#j nil 
        q0j nil 
        q$j nil 
        qoj nil 
  ) 
  (princ) 
) 
(defun c:c2m () 
  (to-modelspace 1) 
) 
(defun c:m2m () 
  (to-modelspace 0) 
) 
(defun to-modelspace (qj / q@ qq ql q& q1 q# q0 q$ qo q| q% q?J qjj q@j qqj 
                         qlj q&j q1j q#j q0j q$j qoj 
                     ) 
  (setq q@ nil 
        qq nil 
        q& nil 
        q1 nil 
        q# nil 
        q0 nil 
        q$ nil 
        qo nil 
        q| nil 
        q% nil 
        q?J nil 
        qjj nil 
        q@j nil 
        qqj nil 
        qlj nil 
        q&j nil 
        q1j nil 
        q#j nil 
        q0j nil 
        q$j nil 
        qoj nil 
  ) 
  (setq ql (getvar "cmdecho") 
        q@ (getvar "expert") 
        qq (getvar "osmode") 
        q& (getvar "cvport") 
  ) 
  (setvar "cmdecho" 0) 
  (setvar "expert" 2) 
  (setvar "osmode" 0) 
  (command "undo" "m") 
  (defun dtr (q|j) 
    (/ (* q|j pi) 180.0) 
  ) 
  (defun rtd (q%j) 
    (/ (* q%j 180.0) pi) 
  )    
    (if (= (getvar "tilemode") 1) 
      (princ "\n \n \n** 该命令不能在模型空间运行,请切换到图纸空间(布局) **") 
      (if (= (length (vports)) 1) 
        (princ "\n \n \n \n当前没有活动的视口.") 
        (progn           
          (setq q?@ *error*) 
          (defun *error* (qj@) 
            (cond 
              ((or 
                 (= qj@ "程序取消") 
                 (= qj@ "控制台中断") 
               ) 
              ) 
            ) 
            (sp2sp_reset) 
          ) 
          (command "pspace") 
          (if (= qj 1) 
            (princ "\n \n选择需要复制(Copy)到模型空间(视口)的对象: \n ") 
            (princ "\n \n选择需要移动(Move)到模型空间(视口)的对象: \n ") 
          ) 
          (setq q# (ssget (quote ((-4 . "<not") (0 . "viewport") 
                                  (-4 . "not>") 
                                 ) 
                          ) 
                   ) 
          ) 
          (if (/= q# nil) 
            (progn 
              (command "mspace") 
              (if (> (length (vports)) 2) 
                (if (= qj 1) 
                  (getpoint (strcat "\n \n \n发现" (itoa (- (length 
                                                                (vports) 
                                                        ) 1 
                                                     ) 
                                               ) " 个视口.\n \n请在需要复制到的视口内指定一点: " 
                            ) 
                  ) 
                  (getpoint (strcat "\n \n \n发现" (itoa (- (length 
                                                                (vports) 
                                                        ) 1 
                                                     ) 
                                               ) " 个视口.\n \n请在需要移动到的视口内指定一点: " 
                            ) 
                  ) 
                ) 
              ) 
              (if (= qj 1) 
                (princ "\n \n正在复制. \n \n请等待...") 
                (princ "\n \n正在移动. \n \n请等待...") 
              ) 
              (command "pspace") 
              (setq q$ (ssget "x" (list (cons 0 "viewport")))) 
              (while (= q1 nil) 
                (setq qo (ssname q$ 0)) 
                (setq q| (entget qo (quote ("acad")))) 
                (setq q% (cadr (assoc (quote -3) q|))) 
                (setq qjj (rtos (/ (cdr (nth 7 q%)) (cdr (assoc 
                                                                (quote 41) 
                                                                q| 
                                                         ) 
                                                    ) 
                                ) 2 6 
                          ) 
                ) 
                (if (= (cdr (assoc (quote 68) q|)) 2) 
                  (setq q1 1) 
                ) 
                (ssdel qo q$) 
              ) 
              (setq qqj (cdr (assoc (quote 10) q|))) 
              (setq q@@ (getvar "ucsname")) 
              (command "ucs" "world") 
              (setvar "highlight" 0) 
              (if (= qj 1) 
                (command "block" "to-modelspace" qqj q# "" "oops") 
                (command "block" "to-modelspace" qqj q# "") 
              ) 
              (if (= q@@ "") 
                (command "ucs" "world") 
                (command "ucs" "r" q@@) 
              ) 
              (command "mspace") 
              (setq qq@ (getvar "ucsname")) 
              (command "ucs" "view") 
              (setq q0 (getvar "viewctr")) 
              (command "insert" "*to-modelspace" q0 qjj "0") 
              (if (= qq@ "") 
                (command "ucs" "world") 
                (command "ucs" "r" qq@) 
              ) 
              (princ "\n \n \n ")              
              (princ "\n \n \n完成... ") 
            ) 
            (progn 
              (princ "\n \n \n") 
              (alert "你没有选择对象!") 
            ) 
          ) 
          (if (= q& 1) 
            (command "pspace") 
            (command "mspace") 
          ) 
        ) 
      ) 
    ) 
   
  (setvar "expert" q@) 
  (setvar "cmdecho" ql) 
  (setvar "osmode" qq) 
  (setvar "highlight" 1) 
  (setq q@ nil 
        qq nil 
        q& nil 
        q1 nil 
        q# nil 
        q0 nil 
        q$ nil 
        qo nil 
        q| nil 
        q% nil 
        q?J nil 
        qjj nil 
        q@j nil 
        qqj nil 
        qlj nil 
        q&j nil 
        q1j nil 
        q#j nil 
        q0j nil 
        q$j nil 
        qoj nil 
  ) 
  (princ) 
) 
(defun sp2sp_reset () 
  (setq *error* q?@) 
  (princ "\n \n \n") 
  (if (= qq@) 
    (command "mspace" "ucs" "r" qq@) 
  ) 
  (if (= q@@) 
    (command "pspace" "ucs" "r" q@@) 
  ) 
  (if (= q& 1) 
    (command "pspace") 
    (command "mspace") 
  ) 
  (setvar "expert" q@) 
  (setvar "cmdecho" ql) 
  (setvar "osmode" qq) 
  (setvar "highlight" 1) 
  (setq q@ nil 
        qq nil 
        ql nil 
        q& nil 
        q1 nil 
        q# nil 
        q0 nil 
        q$ nil 
        qo nil 
        q| nil 
        q% nil 
        q?J nil 
        qjj nil 
        q@j nil 
        qqj nil 
        qlj nil 
        q&j nil 
        q1j nil 
        q#j nil 
        q0j nil 
        q$j nil 
        qoj nil 
  ) 
  (princ "\n \n \necs trapped the error \n") 
  (princ) 
) 
(princ "\n \n \nc2p = 复制到图纸空间 & m2p = 移动到图纸空间\nc2m = 复制到模型空间(视口) & m2m = 移动到模型空间(视口)") 
(princ)

smartstar · 发表于 2015-8-14 16:36:06

edata 发表于 2015-8-14 16:33
你试试这个

谢谢前辈！回头试试，我上面的程序知道怎么修改吗？

rhww · 发表于 2015-8-14 16:40:34

CAD不是自带命令吗

smartstar · 发表于 2015-8-14 16:44:07

edata 发表于 2015-8-14 16:33
你试试这个

谢谢前辈，刚才使用了一下，“c2m = 复制到模型空间(视口)”不是我想要的结果！我想拷贝过去后，图元的相对位置和角度和在布局空间显示的一样的。您提供的程序拷贝到模型空间还需要指点基点，且当视口有旋转角度角度的时候相对角度也会不一样。

smartstar · 发表于 2015-8-14 16:45:53

rhww 发表于 2015-8-14 16:40
CAD不是自带命令吗

自带？命令是什么？

429014673 · 发表于 2015-8-14 17:21:31

CAD自带命令

smartstar · 发表于 2015-8-14 17:29:57

429014673 发表于 2015-8-14 17:21
CAD自带命令

自带？命令是什么？

账号		自动登录	找回密码
密码			注册

[提问] 【矩阵运算】从布局空间复制图元至到模型空间

本帖子中包含更多资源

点评