(defun c:icad_dyjt( / p1 p2 ss_ent tr copy_dyt)
  (setq errold *error*)
  (setq cmdechovar (getvar "cmdecho" ))
  ;清除变量
(defun *error* (msg / eachxx )
  (foreach eachxx '(p1 p2 ss_ent tr copy_dyt)
  (set eachxx nil))
  (setq *error* errold errold nil)
  (Setvar "cmdecho" cmdechovar )
  (princ)
)

(defun tr (pt1 pt2 an n / ss e1 c e en tp pt pt3 pt4)
  (setq ss (ssget "c" (polar pt1 an 3) pt2) c 0)
  (if ss (progn
    (command "line" pt1 pt2 "") (setq e1 (entlast))
    (while (< c (sslength ss))
       (setq e (ssname ss c) en (entget e)
             tp (cdr (assoc 0 en)) pt (polar pt1 an 10))
       (if (= tp "POLYLINE") 
           (setq pt3 (cdr (assoc 10 (entget (entnext e))))
                 pt4 (cdr (assoc 10 (entget (entnext (entnext e))))))
	   )
       (if (= tp "LWPOLYLINE") 
           (setq pt3 (cdr (assoc 10 (entget e)))
                 pt4 (cdr (assoc 10 (reverse (entget e))))
		   )
	   )
       (if (= tp "LINE")
           (setq pt3 (cdr (assoc 10 (entget e)))
                 pt4 (cdr (assoc 11 (entget e))))
       )
       (cond 
          ((= n 1) (progn
              (if (> (cadr pt3) (cadr pt1)) (setq pt pt3))
              (if (> (cadr pt4) (cadr pt1)) (setq pt pt4)))
		  )
          ((= n 2) (progn
              (if (> (car pt3) (car pt1)) (setq pt pt3))
              (if (> (car pt4) (car pt1)) (setq pt pt4)))
		  )
          ((= n 3) (progn
              (if (< (cadr pt3) (cadr pt1)) (setq pt pt3))
              (if (< (cadr pt4) (cadr pt1)) (setq pt pt4)))
		  )
          ((= n 4) (progn
              (if (< (car pt3) (car pt1)) (setq pt pt3))
              (if (< (car pt4) (car pt1)) (setq pt pt4)))
		  )
       )
       (if (and (/= tp "INSERT")(/= tp "TEXT")) (command "trim" e1 "" (list e pt) ""))
       (setq c (+ 1 c))
    )
    (command "erase" e1 "")
  ))
)

(defun copy_dyt(p1 p2 ss / e elast l an a b c d e sca sss bl p_l p_r p1 p2 na_block rl
                           p122 en entn xbl lay p_ins sss p00 p12 ang i f li_dy path carr sspt1 sspt2)
  (command "osnap" "")
  (setq p_l(getvar "extmin") p_r(getvar"extmax"))
  (setq ang(angle p1 p2) l(/ (distance p1 p2) 2))
  (setq p12(polar p1 ang l))
  (if (NULL (setq p122 (getpoint p12 (ICAD_Get_ResText 196 "\n请选择复制位置:"))))
    (setq p122(list(car p12)(+(cadr p_r)(* (abs(- (cadr p1)(cadr p2))) 4))))
  )
  
  (setq p1(polar p122 (+ ang pi) l) p2(polar p122 ang l))
  (command "undo" "group")
  (if ss(progn
    (command "copy" ss "" p12 p122)
    (command "zoom" "e")
    (setq ss nil)
    (setq ss (ssget "c" p1 p2) sspt1 p1 sspt2 p2)
    (if (/= nil ss)(progn
      (tr p1 (list (car p2) (cadr p1)) (* pi 0.5) 1)
      (tr (list (car p2) (cadr p1)) p2 0 2)
      (tr p2 (list (car p1) (cadr p2)) (* pi 1.5) 3)
      (tr (list (car p1) (cadr p2)) p1 pi 4)
      (setq p1(polar p122 (+ ang pi) (* l 1.1)) p2(polar p122 ang (* l 1.1))) 
      (setq i 0)

      (if (NULL (setq sca(getreal (ICAD_Get_ResText 197 "\n请输入缩放比例,图块和文字会相应缩放<回车不缩放>:"))))
          (setq sca 1.0)
      )

	  (if (/= sca 1.0)
	    (progn
	      ; TTZHQ-9074 - Li ZiZhuang - 2009-01-08 (集成问题)扩展工具——大样截图有问题
	      ; 问题:只处理了块和文字
	     (setq ss nil)
    	     (setq ss (ssget "c" sspt1 sspt2))
	     (command "scale" ss "" p122 sca)
		 ;| (while(< i(sslength ss))
			(setq entn(ssname ss i) en(entget entn))		   
			(if (=(cdr(assoc 0 en)) "INSERT")
			  (progn (setq p_ins(cdr(assoc 10 en))) (command "scale" entn "" p_ins sca))
			)
		        (if(= "TEXT" (cdr (assoc 0 en)))
		           (progn (setq p_ins(cdr(assoc 10 en))) (command "scale" entn "" p_ins sca))
		        ) 
		   (setq i(1+ i))
		 )|;
	     )
	 )
   ))
   (command "zoom" "p")
  )) 
  (command "undo" "end")
  (princ)
)

   (setvar "cmdecho" 0)
   (prompt (ICAD_Get_ResText 198 "\n请框选大样图的范围"))
   (initget 7)
   (setq p1 (getpoint (ICAD_Get_ResText 199 "\n请点取大样图左上角:")))
   (initget 7)
   (setq p2 (getcorner p1 (ICAD_Get_ResText 200 "\n请点取右下角:")))
   (setq ss_ent(ssget"c" p1 p2))
   (if ss_ent (progn
       (copy_dyt p1 p2 ss_ent)
   ))
 (Setvar "cmdecho" cmdechovar )
   (setq *error* errold errold nil)
   (princ)
)
