带状图如何批量布局和套图框？

依然小小鸟 · 发表于 2021-4-9 16:52:40

Atsai 发表于 2021-3-23 16:27
http://bbs.mjtd.com/thread-113576-1-1.html

适用于图块的框。

从来没有成功过你那里有你测试成功的测试图吗辛苦共享一下

依然小小鸟 · 发表于 2021-4-9 17:01:18

tranney 发表于 2021-3-24 01:42
他的我用过，很好用

你那里有完整的代码或者程序吗他网址里面的代码不全

tranney · 发表于 2021-4-10 21:33:43

依然小小鸟发表于 2021-4-9 17:01
你那里有完整的代码或者程序吗他网址里面的代码不全

(defun MAT:mxp (m p)
(reverse (cdr (reverse (MAT:mxv m (append p '(1.0))))))
)
(defun MAT:mxm (m q)
(mapcar (function (lambda (r) (MAT:mxv (MAT:trp q) r))) m)
)
(defun Mat:DispToMatrix (mat disp)
(append
(mapcar 'append mat (mapcar 'list disp))
'((0. 0. 0. 1.))
)
)
(defun MAT:mxv (m v)
(mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m)
)
(defun MAT:trp (m)
(apply 'mapcar (cons 'list m))
)
(defun MAT:Trans1 (from to Org Ang / Mat Rot Inv Cen)
(setq Mat (mapcar (function (lambda (v) (trans v from to T)))
'((1. 0. 0.) (0. 1. 0.) (0. 0. 1.))
)
)
(if (not (equal ang 0 1e-14))
(setq Rot (list (list (cos ang) (- (sin ang)) 0.)
(list (sin ang) (cos ang) 0.)
(list 0. 0. 1.)
)
mat (MAT:mxm mat Rot)
)
)
(setq Cen (trans Org to from))
(setq Inv (mat:trp mat))
(list
(Mat:DispToMatrix Inv (mat:mxv Inv (mapcar '- Cen))) ;from->to (trans pt from to)
(Mat:DispToMatrix mat Cen) ;to->from (trans pt to from)
)
)
(defun Mat:EntityMatrix (Ent / z dxf Cen obj an m1 mat Inv org)
(setq dxf (entget ent))
(if (setq Cen (cdr (assoc 10 dxf))) ;Insertpoint,center or startpoint,etc.
(if (null (caddr Cen))
(setq Cen (append Cen '(0.0)))
)
(setq Cen '(0 0 0))
)
(setq obj (vlax-ename->vla-object Ent))
(if (and (vlax-property-available-p obj 'elevation) ;If it has elevation value.
(wcmatch (vla-get-objectname obj) "*Polyline") ;It's a "AcDb2dPolyline" or "AcDbPolyline" object
)
(setq z (vla-get-elevation obj)
Cen (list (car Cen) (cadr Cen) (+ (caddr Cen) z)) ;add elevation value
)
)
(if (vlax-property-available-p obj 'rotation) ;if it has a rotaion angle
(setq an (vla-get-rotation obj))
(setq an 0)
)
(MAT:Trans1 0 Ent Cen an) ;return two matrices, the first is WCS->OCS,the second is OCS->WCS
)
(defun HH:Ent4pt (ent Flag / ENT LST MAT MAT1 MATLST MATRIX
MAXPT MINPT OBJ ORIGIN REVMAT UCSFLAG WCSORG X XDIR
YDIR ZDIR
)
;;1 矩阵的变换与逆变换
(defun GetMatrix (lst org Revflag / I J MAT)
(setq mat (vlax-make-safearray vlax-vbDouble '(0 . 3) '(0 . 3)))
(setq i 0)
(repeat 3
(vlax-safearray-put-element mat i 3 (nth i org)) ;平移变换
(setq j 0)
(repeat 3
(if RevFlag
(vlax-safearray-put-element mat i j (nth j (nth i lst))) ;角度逆变换
(vlax-safearray-put-element mat i j (nth i (nth j lst))) ;角度的变换
)
(setq j (1+ j))
)
(setq i (1+ i))
)
(vlax-safearray-put-element mat 3 3 1)
mat ;返回矩阵
)
;;2 本程序主程序
(cond ((= (type ent) 'ENAME)
(setq obj (vlax-ename->vla-object ent))
)
((= (type ent) 'VLA-OBJECT) (setq obj ent))
(T (exit))
)
(and Flag
(setq Mat (Mat:EntityMatrix ent))
(setq Mat1 (cadr Mat))
(setq Mat (car Mat))
)
(setq UcsFlag (getvar "WORLDUCS"))
(if (= UcsFlag 0) ;UCS与WCS不同
(setq UcsFlag T ;设置标志位为true
xdir (getvar "UCSXDIR") ;X方向矢量
ydir (getvar "UCSYDIR") ;Y方向矢量
zdir (MAT:vxv xdir ydir) ;X和Y的方向矢量的叉积
origin (getvar "UCSORG") ;原点
WcsOrg (trans '(0 0 0) 0 1) ;WCS的原点相对UCS的坐标
matLst (list xdir ydir zdir) ;旋转的变换矩阵表
matrix (GetMatrix matLst origin nil) ;从WCS到UCS(ocs)的变换矩阵
revMat (GetMatrix matLst WcsOrg T) ;从UCS(ocs)到WCS的变换矩阵
)
(setq UcsFlag nil) ;否则不予变换
)
;;在UCS下先变换物体到WCS下，取得物体的包围框，然后把物体变换回到UCS
(cond ((and Flag UcsFlag) (vla-TransformBy obj (vlax-tmatrix Mat)))
(UcsFlag (vla-TransformBy obj revMat))
(Flag (vla-TransformBy obj (vlax-tmatrix Mat)))
)
(vla-GetBoundingBox obj 'minPt 'maxPt) ;得到包围框
(setq minPt (vlax-safearray->list minPt))
(setq maxPt (vlax-safearray->list maxPt))
(cond ((and Flag UcsFlag) (vla-TransformBy obj (vlax-tmatrix Mat1)))
(UcsFlag (vla-TransformBy obj matrix))
(Flag (vla-TransformBy obj (vlax-tmatrix Mat1)))
)
(setq lst (list minPt
(list (car maxPt) (cadr minpt) (caddr minPt))
maxPt
(list (car minpt) (cadr maxPt) (caddr minPt))
)
)
(COND (Flag nil)
(UcsFlag (setq mat1 (vlax-safearray->list matrix)))
)
(cond ((or Flag UcsFlag)
(setq lst (mapcar '(lambda (x) (mat:mxp mat1 x)) lst)) ;wcs坐标
(setq lst (mapcar '(lambda (x) (trans x ent 1)) lst))
)
)
lst
)
(defun c:zcai_skd (/ cp cl cs vpl os vplyes l0 svpc ptlst ssvp)
(vl-load-com)
(princ "\n说明：批量图块(可旋转)产生视口")
(setvar "cmdecho" 0) ; Turn off command line echoing
(setq cp (getvar "ctab")) ; Store current tab name
(setq cl (getvar "clayer")) ; Store current layer name
(setq cs (getvar "osmode")) ; Store current osnap mode
(setq vpl "0-批量视口") ; ==>> Assume using Viewport layer for viewport frames, change code value here if needed <<==
(setq os (getvar "osmode")) ;读取锁点原设定
(setvar "osmode" 0)
(setq nselect
(getstring
"\n选择排序方式,(1)自选顺序(2)左->右(3)右->左(4)上->下(5)下->上：预设(1)"
)
)
(if (= nselect "")
(setq nselect "1")
)
(if (/= cp "Model") ; Must be started from a layout tab to establish destination, quit quietly if on Model tab
(progn
(setq vplyes 0) ; Assume viewport doesn't exist
(setq l0 (tblnext "LAYER" 1)) ; Get past 0 layer in layer list
(while (setq layers (tblnext "LAYER"))
;; Loop through layer list collection
(setq ln (cdr (assoc 2 layers))) ; Extract layer name from list
(if (= (strcase ln) (strcase vpl))
(setq vplyes 1)
) ; Check if viewport layer exists
)
(if (= vplyes 0)
(command "layer" "NEW" vpl "COLOR" "RED" vpl "")
) ; Make viewport layer and assign color to magenta if doesn't exist
(setvar "clayer" vpl) ; Change to viewport layer
(command "layer"
"ON"
(strcat "0," vpl)
"UNLOCK"
(strcat "0," vpl)
""
) ; Turn on and unlock viewport and 0 layer
(command "zoom" "ALL") ; View entire layout tab
(setvar "ctab" "Model") ; Activate Model tab
(command "zoom" "E") ; View entire Model Space area
(setq ss nil)
(if (setq ss (ssget '((0 . "INSERT"))))
(progn
(setq l (sslength ss)
i 0
)
(setq ent_lst nil)
(repeat (sslength ss)
(setq ent_lst (append ent_lst (list (ssname ss i)))
i (1+ i)
)
)
(princ "\n") ; Clean up command line
(setvar "ctab" cp) ; Return to layout tab program was started from
(command "pspace") ; Switch to Paper Space of layout tab
(setq ptlst nil)
(setq ptlst (HH:Ent4pt (nth 0 ent_lst) T))
(setq vpc1 (nth 0 ptlst))
(setq vpc2 (nth 1 ptlst))
(setq vpc3 (nth 2 ptlst))
(setq vpc4 (nth 3 ptlst))
(setq sf 1.0)
(setq vpyd (* sf (distance vpc2 vpc3)))
(defun viewpnts (/ a b c d x)
(setq b (getvar "viewsize")
c (car (getvar "screensize"))
d (cadr (getvar "screensize"))
a (* b (/ c d))
x (setq x (getvar "viewctr"))
x (trans x 1 2)
c (list (- (car x) (/ a 2.0)) (- (cadr x) (/ b 2.0)) 0.0)
d (list (+ (car x) (/ a 2.0)) (+ (cadr x) (/ b 2.0)) 0.0)
c (trans c 2 1)
d (trans d 2 1)
)
(list c d)
)
(setq c (nth 0 (viewpnts)))
(setq d (nth 1 (viewpnts)))
(setq mvpc (list (/ (+ (car c) (car d)) 2.0) (/ (+ (cadr c) (cadr d)) 2.0) 0.0))
(command "zoom" "C" mvpc (rtos (* (* 2 l) vpyd)))
(setq svpc
(getpoint
"\n选择插入点："
)
) ; Can't change layout tabs manually here
(cond
((= nselect "1")
(setq ent_lst ent_lst)
)
((= nselect "2")
(progn
;;按X座标排序
(setq
ent_lst (vl-sort ent_lst
'(lambda (e1 e2)
(< (cadr (assoc 10 (entget e1)))
(cadr (assoc 10 (entget e2)))
)
)
)
)
;;按X座标排序
)
)
((= nselect "3")
(progn
;;按X座标排序
(setq
ent_lst (vl-sort ent_lst
'(lambda (e1 e2)
(> (cadr (assoc 10 (entget e1)))
(cadr (assoc 10 (entget e2)))
)
)
)
)
;;按X座标排序
)
)
((= nselect "4")
(progn
;;按Y座标排序
(setq
ent_lst (vl-sort ent_lst
'(lambda (e1 e2)
(> (caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2)))
)
)
)
)
;;按Y座标排序
)
)
((= nselect "5")
(progn
;;按Y座标排序
(setq
ent_lst (vl-sort ent_lst
'(lambda (e1 e2)
(< (caddr (assoc 10 (entget e1)))
(caddr (assoc 10 (entget e2)))
)
)
)
)
;;按Y座标排序
)
)
)
(mapcar
'(lambda (ssn)
(setq ptlst nil)
(setq ptlst (HH:Ent4pt ssn T))
(setq vpc1 (nth 0 ptlst))
(setq vpc2 (nth 1 ptlst))
(setq vpc3 (nth 2 ptlst))
(setq vpc4 (nth 3 ptlst))
(setq sf 1.0)
(setq vpxd (* sf (distance vpc1 vpc2)))
;; Determine horizontal length of selected window
(setq vpyd (* sf (distance vpc2 vpc3)))
;; Determine vertical height of selected window
(setq
vpc
(list (/ (+ (car vpc1) (car vpc3)) 2.0)
(/ (+ (cadr vpc1) (cadr vpc3)) 2.0)
0.0
)
)
;; Determine center point of selected model window
(command "mview"
(list (car svpc) (cadr svpc))
(strcat "@" (rtos vpxd) "," (rtos vpyd))
)
;; Create Paper Space viewport
(setq ssvp nil)
(setq ssvp (ssget "L"))
;; Start selection set with last viewport frame
(command "zoom"
"w"
(list (car svpc) (cadr svpc))
(strcat "@" (rtos vpxd) "," (rtos vpyd))
)
(command "mspace")
;; Open viewport window to Model Space
(command "ucsicon" "ON")
;; Turn on UCS icon for viewport
(command "ucs" "Z" "non" vpc1 "non" vpc2)
(command "Plan" "")
(command "ucs" "WORLD") ; Reset UCS to WCS
(command "zoom" "C" vpc (rtos vpyd))
;; Center view of viewport window using determined point
(command "zoom" "SCALE" (strcat (rtos sf) "XP"))
;; Set zoom scale of viewport window
(command "vports" "LOCK" "ON" ssvp "")
;; Lock scale and position of model in viewport
(command "pspace")
;; Close viewport window
(setq w (distance vpc1 vpc2))
(setq svpc (polar svpc 0 (* 1.5 w)))
)
ent_lst
)
)
)
)
(princ "\n这个LISP程式只能在Layout(布局)使用！")
;; Need to start on a layout tab so program knows where to create the new viewports
)
(command "zoom" "all")
(setvar "ctab" cp) ; Reset to stored tab name
(setvar "clayer" cl) ; Reset to stored layer name
(setvar "osmode" os) ;回复锁点原设定
(princ)
)

(defun MAT:mxp (m p) 
  (reverse (cdr (reverse (MAT:mxv m (append p '(1.0)))))) 
) 
 
(defun MAT:mxm (m q) 
  (mapcar (function (lambda (r) (MAT:mxv (MAT:trp q) r))) m) 
) 
 
(defun Mat:DispToMatrix        (mat disp) 
  (append 
    (mapcar 'append mat (mapcar 'list disp)) 
    '((0. 0. 0. 1.)) 
  ) 
) 
(defun MAT:mxv (m v) 
  (mapcar (function (lambda (r) (apply '+ (mapcar '* r v)))) m) 
) 
 
(defun MAT:trp (m) 
  (apply 'mapcar (cons 'list m)) 
) 
(defun MAT:Trans1 (from to Org Ang / Mat Rot Inv Cen) 
  (setq Mat (mapcar (function (lambda (v) (trans v from to T))) 
                    '((1. 0. 0.) (0. 1. 0.) (0. 0. 1.)) 
            ) 
  ) 
  (if (not (equal ang 0 1e-14)) 
    (setq Rot (list (list (cos ang) (- (sin ang)) 0.) 
                    (list (sin ang) (cos ang) 0.) 
                    (list 0. 0. 1.) 
              ) 
          mat (MAT:mxm mat Rot) 
    ) 
  ) 
  (setq Cen (trans Org to from)) 
  (setq Inv (mat:trp mat)) 
  (list 
    (Mat:DispToMatrix Inv (mat:mxv Inv (mapcar '- Cen)))        ;from->to (trans pt from to) 
    (Mat:DispToMatrix mat Cen)                                         ;to->from (trans pt to from) 
  ) 
) 
 
(defun Mat:EntityMatrix (Ent / z dxf Cen obj an m1 mat Inv org) 
  (setq dxf (entget ent)) 
  (if (setq Cen (cdr (assoc 10 dxf)))                                ;Insertpoint,center or startpoint,etc. 
    (if (null (caddr Cen)) 
      (setq Cen (append Cen '(0.0))) 
    ) 
    (setq Cen '(0 0 0)) 
  ) 
  (setq obj (vlax-ename->vla-object Ent))                        
  (if (and (vlax-property-available-p obj 'elevation)                ;If it has elevation value. 
           (wcmatch (vla-get-objectname obj) "*Polyline")        ;It's a "AcDb2dPolyline" or "AcDbPolyline" object 
      ) 
    (setq z   (vla-get-elevation obj) 
          Cen (list (car Cen) (cadr Cen) (+ (caddr Cen) z))        ;add elevation value 
    ) 
  ) 
  (if (vlax-property-available-p obj 'rotation)                 ;if it has a rotaion angle 
    (setq an (vla-get-rotation obj)) 
    (setq an 0) 
  ) 
  (MAT:Trans1 0 Ent Cen an)                                         ;return two matrices, the first is WCS->OCS,the second is OCS->WCS 
) 
 
(defun HH:Ent4pt (ent   Flag   /   ENT   LST   MAT   MAT1   MATLST  MATRIX 
    MAXPT   MINPT   OBJ   ORIGIN  REVMAT  UCSFLAG WCSORG  X   XDIR 
    YDIR   ZDIR 
   ) 
  ;;1 矩阵的变换与逆变换 
  (defun GetMatrix (lst org Revflag / I J MAT) 
    (setq mat (vlax-make-safearray vlax-vbDouble '(0 . 3) '(0 . 3))) 
    (setq i 0) 
    (repeat 3 
      (vlax-safearray-put-element mat i 3 (nth i org))     ;平移变换 
      (setq j 0) 
      (repeat 3 
(if RevFlag 
   (vlax-safearray-put-element mat i j (nth j (nth i lst))) ;角度逆变换 
   (vlax-safearray-put-element mat i j (nth i (nth j lst))) ;角度的变换 
) 
(setq j (1+ j)) 
      ) 
      (setq i (1+ i)) 
    ) 
    (vlax-safearray-put-element mat 3 3 1) 
    mat           ;返回矩阵 
  ) 
  ;;2 本程序主程序 
  (cond ((= (type ent) 'ENAME) 
  (setq obj (vlax-ename->vla-object ent)) 
) 
((= (type ent) 'VLA-OBJECT) (setq obj ent)) 
(T (exit)) 
  ) 
  (and Flag 
       (setq Mat (Mat:EntityMatrix ent)) 
       (setq Mat1 (cadr Mat)) 
       (setq Mat (car Mat)) 
  ) 
  (setq UcsFlag (getvar "WORLDUCS")) 
  (if (= UcsFlag 0)         ;UCS与WCS不同 
    (setq UcsFlag T         ;设置标志位为true 
   xdir   (getvar "UCSXDIR")       ;X方向矢量 
   ydir   (getvar "UCSYDIR")       ;Y方向矢量 
   zdir   (MAT:vxv xdir ydir)       ;X和Y的方向矢量的叉积 
   origin  (getvar "UCSORG")       ;原点 
   WcsOrg  (trans '(0 0 0) 0 1)       ;WCS的原点相对UCS的坐标 
   matLst  (list xdir ydir zdir)       ;旋转的变换矩阵表 
   matrix  (GetMatrix matLst origin nil)      ;从WCS到UCS(ocs)的变换矩阵 
   revMat  (GetMatrix matLst WcsOrg T)      ;从UCS(ocs)到WCS的变换矩阵 
    ) 
    (setq UcsFlag nil)         ;否则不予变换 
  ) 
  ;;在UCS下先变换物体到WCS下，取得物体的包围框，然后把物体变换回到UCS 
  (cond ((and Flag UcsFlag) (vla-TransformBy obj (vlax-tmatrix Mat))) 
(UcsFlag (vla-TransformBy obj revMat)) 
(Flag (vla-TransformBy obj (vlax-tmatrix Mat))) 
  ) 
  (vla-GetBoundingBox obj 'minPt 'maxPt)      ;得到包围框 
  (setq minPt (vlax-safearray->list minPt)) 
  (setq maxPt (vlax-safearray->list maxPt)) 
  (cond ((and Flag UcsFlag) (vla-TransformBy obj (vlax-tmatrix Mat1))) 
(UcsFlag (vla-TransformBy obj matrix)) 
(Flag (vla-TransformBy obj (vlax-tmatrix Mat1))) 
  ) 
  (setq lst (list minPt 
    (list (car maxPt) (cadr minpt) (caddr minPt)) 
    maxPt 
    (list (car minpt) (cadr maxPt) (caddr minPt)) 
     ) 
  ) 
  (COND (Flag nil) 
(UcsFlag (setq mat1 (vlax-safearray->list matrix))) 
  ) 
  (cond ((or Flag UcsFlag) 
  (setq lst (mapcar '(lambda (x) (mat:mxp mat1 x)) lst)) ;wcs坐标 
  (setq lst (mapcar '(lambda (x) (trans x ent 1)) lst)) 
) 
  ) 
  lst 
) 
 
 
(defun c:zcai_skd (/ cp cl cs vpl os vplyes l0 svpc ptlst ssvp) 
  (vl-load-com) 
(princ "\n说明：批量 图块(可旋转)产生视口") 
  (setvar "cmdecho" 0) ; Turn off command line echoing 
  (setq cp (getvar "ctab")) ; Store current tab name 
  (setq cl (getvar "clayer")) ; Store current layer name 
  (setq cs (getvar "osmode")) ; Store current osnap mode 
  (setq vpl "0-批量视口") ; ==>> Assume using Viewport layer for viewport frames, change code value here if needed <<== 
  (setq os (getvar "osmode")) ;读取锁点原设定 
  (setvar "osmode" 0) 
 
  (setq        nselect 
         (getstring 
           "\n选择排序方式,(1)自选顺序(2)左->右(3)右->左(4)上->下(5)下->上：预设(1)" 
         ) 
  ) 
 
  (if (= nselect "") 
    (setq nselect "1") 
  ) 
 
  (if (/= cp "Model") ; Must be started from a layout tab to establish destination, quit quietly if on Model tab 
    (progn 
      (setq vplyes 0) ; Assume viewport doesn't exist 
      (setq l0 (tblnext "LAYER" 1)) ; Get past 0 layer in layer list 
      (while (setq layers (tblnext "LAYER")) 
        ;; Loop through layer list collection 
        (setq ln (cdr (assoc 2 layers))) ; Extract layer name from list 
        (if (= (strcase ln) (strcase vpl)) 
          (setq vplyes 1) 
        ) ; Check if viewport layer exists 
      ) 
      (if (= vplyes 0) 
        (command "layer" "NEW" vpl "COLOR" "RED" vpl "") 
      ) ; Make viewport layer and assign color to magenta if doesn't exist 
      (setvar "clayer" vpl) ; Change to viewport layer 
      (command "layer" 
               "ON" 
               (strcat "0," vpl) 
               "UNLOCK" 
               (strcat "0," vpl) 
               "" 
      ) ; Turn on and unlock viewport and 0 layer 
      (command "zoom" "ALL") ; View entire layout tab 
      (setvar "ctab" "Model") ; Activate Model tab 
      (command "zoom" "E") ; View entire Model Space area 
      (setq ss nil) 
      (if (setq ss (ssget '((0 . "INSERT")))) 
        (progn 
          (setq        l (sslength ss) 
                i 0 
          ) 
 
          (setq ent_lst nil) 
          (repeat (sslength ss) 
            (setq ent_lst (append ent_lst (list (ssname ss i))) 
                  i          (1+ i) 
            ) 
          ) 
 
          (princ "\n") ; Clean up command line 
          (setvar "ctab" cp) ; Return to layout tab program was started from 
          (command "pspace") ; Switch to Paper Space of layout tab 
 
          (setq ptlst nil) 
          (setq ptlst (HH:Ent4pt (nth 0 ent_lst) T)) 
          (setq vpc1 (nth 0 ptlst)) 
          (setq vpc2 (nth 1 ptlst)) 
          (setq vpc3 (nth 2 ptlst)) 
          (setq vpc4 (nth 3 ptlst)) 
          (setq sf 1.0) 
          (setq vpyd (* sf (distance vpc2 vpc3))) 
 
 
          (defun viewpnts (/ a b c d x) 
            (setq b (getvar "viewsize") 
                  c (car (getvar "screensize")) 
                  d (cadr (getvar "screensize")) 
                  a (* b (/ c d)) 
                  x (setq x (getvar "viewctr")) 
                  x (trans x 1 2) 
                  c (list (- (car x) (/ a 2.0)) (- (cadr x) (/ b 2.0)) 0.0) 
                  d (list (+ (car x) (/ a 2.0)) (+ (cadr x) (/ b 2.0)) 0.0) 
                  c (trans c 2 1) 
                  d (trans d 2 1) 
            ) 
            (list c d) 
          ) 
 
          (setq c (nth 0 (viewpnts))) 
          (setq d (nth 1 (viewpnts))) 
 
          (setq mvpc (list (/ (+ (car c) (car d)) 2.0) (/ (+ (cadr c) (cadr d)) 2.0) 0.0)) 
          (command "zoom" "C" mvpc (rtos (* (* 2 l) vpyd))) 
 
 
          (setq        svpc 
                 (getpoint 
                   "\n选择插入点：" 
                 ) 
          ) ; Can't change layout tabs manually here 
 
 
          (cond 
            ((= nselect "1") 
             (setq ent_lst ent_lst) 
            ) 
 
            ((= nselect "2") 
             (progn 
               ;;按X座标排序 
               (setq 
                 ent_lst (vl-sort ent_lst 
                                  '(lambda (e1 e2) 
                                     (<        (cadr (assoc 10 (entget e1))) 
                                        (cadr (assoc 10 (entget e2))) 
                                     ) 
                                   ) 
                         ) 
               ) 
               ;;按X座标排序 
             ) 
            ) 
 
            ((= nselect "3") 
             (progn 
               ;;按X座标排序 
               (setq 
                 ent_lst (vl-sort ent_lst 
                                  '(lambda (e1 e2) 
                                     (>        (cadr (assoc 10 (entget e1))) 
                                        (cadr (assoc 10 (entget e2))) 
                                     ) 
                                   ) 
                         ) 
               ) 
               ;;按X座标排序 
             ) 
            ) 
 
            ((= nselect "4") 
             (progn 
               ;;按Y座标排序 
               (setq 
                 ent_lst (vl-sort ent_lst 
                                  '(lambda (e1 e2) 
                                     (>        (caddr (assoc 10 (entget e1))) 
                                        (caddr (assoc 10 (entget e2))) 
                                     ) 
                                   ) 
                         ) 
               ) 
               ;;按Y座标排序 
             ) 
            ) 
 
            ((= nselect "5") 
             (progn 
               ;;按Y座标排序 
               (setq 
                 ent_lst (vl-sort ent_lst 
                                  '(lambda (e1 e2) 
                                     (<        (caddr (assoc 10 (entget e1))) 
                                        (caddr (assoc 10 (entget e2))) 
                                     ) 
                                   ) 
                         ) 
               ) 
               ;;按Y座标排序 
             ) 
            ) 
          ) 
 
          (mapcar 
            '(lambda (ssn) 
               (setq ptlst nil) 
               (setq ptlst (HH:Ent4pt ssn T)) 
               (setq vpc1 (nth 0 ptlst)) 
               (setq vpc2 (nth 1 ptlst)) 
               (setq vpc3 (nth 2 ptlst)) 
               (setq vpc4 (nth 3 ptlst)) 
 
               (setq sf 1.0) 
               (setq vpxd (* sf (distance vpc1 vpc2))) 
               ;; Determine horizontal length of selected window 
               (setq vpyd (* sf (distance vpc2 vpc3))) 
               ;; Determine vertical height of selected window 
               (setq 
                 vpc 
                  (list        (/ (+ (car vpc1) (car vpc3)) 2.0) 
                        (/ (+ (cadr vpc1) (cadr vpc3)) 2.0) 
                        0.0 
                  ) 
               ) 
               ;; Determine center point of selected model window 
 
               (command        "mview" 
                        (list (car svpc) (cadr svpc)) 
                        (strcat "@" (rtos vpxd) "," (rtos vpyd)) 
               ) 
               ;; Create Paper Space viewport 
 
               (setq ssvp nil) 
 
               (setq ssvp (ssget "L")) 
               ;; Start selection set with last viewport frame 
 
 
               (command        "zoom" 
                        "w" 
                        (list (car svpc) (cadr svpc)) 
                        (strcat "@" (rtos vpxd) "," (rtos vpyd)) 
               ) 
 
                
               (command "mspace") 
               ;; Open viewport window to Model Space 
 
               (command "ucsicon" "ON") 
               ;; Turn on UCS icon for viewport 
 
               (command "ucs" "Z" "non" vpc1 "non" vpc2) 
 
               (command "Plan" "") 
 
               (command "ucs" "WORLD") ; Reset UCS to WCS 
 
               (command "zoom" "C" vpc (rtos vpyd)) 
               ;; Center view of viewport window using determined point 
               (command "zoom" "SCALE" (strcat (rtos sf) "XP")) 
               ;; Set zoom scale of viewport window 
 
               (command "vports" "LOCK" "ON" ssvp "") 
               ;; Lock scale and position of model in viewport 
               (command "pspace") 
               ;; Close viewport window 
 
               (setq w (distance vpc1 vpc2)) 
               (setq svpc (polar svpc 0 (* 1.5 w))) 
 
             ) 
            ent_lst 
          ) 
        ) 
      ) 
    ) 
    (princ "\n这个LISP程式只能在Layout(布局)使用！") 
    ;; Need to start on a layout tab so program knows where to create the new viewports 
  ) 
  (command "zoom" "all") 
  (setvar "ctab" cp) ; Reset to stored tab name 
  (setvar "clayer" cl) ; Reset to stored layer name 
  (setvar "osmode" os) ;回复锁点原设定 
  (princ) 
)

tranney · 发表于 2021-4-10 21:34:44

命令为zcai_skd

★胜/tp驮 · 发表于 2021-6-18 18:05:23

tranney 发表于 2021-4-10 21:34
命令为zcai_skd

运行失败，什么情况

p-3-ianlcc · 发表于 2021-6-22 10:56:01

tranney 发表于 2021-4-10 21:34
命令为zcai_skd

咝谐晒

依然小小鸟 · 发表于 2021-6-22 12:14:47

p-3-ianlcc 发表于 2021-6-22 10:56
咝谐晒

成功了吗

p-3-ianlcc · 发表于 2021-6-25 17:49:56

依然小小鸟发表于 2021-6-22 12:14
成功了吗

成功了…不過，還在適試中！

依然小小鸟 · 发表于 2021-6-26 09:47:40

p-3-ianlcc 发表于 2021-6-25 17:49
成功了…不過，還在適試中！

怎么操作呢

p-3-ianlcc · 发表于 2021-6-28 09:46:31

依然小小鸟发表于 2021-6-26 09:47
怎么操作呢

您好
我是COPY「tranney」所提供的CODE使用
命令是：zcai_skd

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

[提问] 带状图如何批量布局和套图框？