;Shusei Hayashi
;OffshoreCad&Management Inc.
;10F Jaka Bldg., 6780 Ayala Ave.,
;Makati, Philippines
;http://www.offshorecad.com.ph/
;http://www.offshore-management.com.ph/

(defun c:SD_1610 (/ rot1 obj1 obj2 ins1 ins1x ins1y scl1 scl2 lin1 lay1 lt1 pos1 Flag)
	(if (= SD:Lang "E")
		(princ "\n Copy Objects on Xref or Block")
		(princ "\n 外部参照・ブロック上の図形をコピー")
	)
	(princ "\n **********************************")
	(setq *error* *myerror*)
	(SD1028)
	
	(while (= obj2 nil)
		(setvar "ERRNO" 0)
		(if (= SD:Lang "E")
			(setq	obj1 (nentsel "\n Select object in xref to copy: "))
			(setq	obj1 (nentsel "\n 外部参照・ブロック上の図形を指示： "))
		)
		(if obj1
			(if (> (length obj1) 2);(= (cdr (assoc 0 (entget (car (last obj1))))) "INSERT")
				(if (/= (cdr (assoc 0 (entget (car obj1)))) "ATTRIB")
					(setq 	obj2 (car obj1))
					(if (= SD:Lang "E")
						(princ "\n Cannot copy that obj.")
						(princ "\n 属性はこぴーできません.")
					)
				)
				(if (= SD:Lang "E")
						(princ "\n Cannot copy that obj.")
						(princ "\n 外部参照・ブロック上にありません.")
				)
			)
		)
		( if (= (getvar "ERRNO") 52)
			(vl-exit-with-error "")	
		)
	)
	(if (= (getvar "celtype") "ByLayer")
		(setq Flag T)
	)
	(setq 	ent1 (car obj1)
			ent1 (entget ent1))
	(if (setq pos1 (vl-string-search "|" (cdr (assoc 8 ent1))))
		(if (tblsearch "LAYER" (setq lay1 (substr (cdr (assoc 8 ent1)) (+ pos1 2))))
			(setq ent1 (subst (cons 8 lay1) (assoc 8 ent1) ent1))
			(setq ent1 (subst (cons 8 (getvar "clayer")) (assoc 8 ent1) ent1))
		)
	)
	(if (and (assoc 6 ent1)(setq pos1 (vl-string-search "|" (cdr (assoc 6 ent1)))))
			(if (tblsearch "LTYPE" (setq lt1 (substr (cdr (assoc 6 ent1)) (+ pos1 2))))
					;その線種を持っていれば
					(setq ent1 (subst (cons 6 lt1) (assoc 6 ent1) ent1))	
					;線種がなければ現在層で
					(progn
						(if Flag  (setq ent1(vl-remove-if '(lambda(x)(= 6 (car x))) ent1))	;現在がBylayerなら6を取る
								 (setq ent1(subst (cons 6 (getvar "celtype")) (assoc 6 ent1) ent1))		;現在がByLayer以外
						)
						(if (= SD:Lang "E")
							(princ "\n New Object is drawon on current layer\n")
							(princ "\n 線種が無いので現在の線種で作図\n")
						)									
					)
			)
	)
	(entmake ent1)
	(setq lin1 (entlast))
	(setq 	*error* *myerror_1610*)
	(setq	obj2 (last obj1)
			ins1 (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) obj2)
			ins1x (mapcar 'car ins1)
			ins1x (apply '+ ins1x)
			ins1y (mapcar 'cadr ins1)
			ins1y (apply '+ ins1y)
			ins1 (list ins1x ins1y)
			rot1 (mapcar '(lambda (x) (cdr (assoc 50 (entget x)))) obj2)
			rot1 (apply '+ rot1)
			scl1 (mapcar '(lambda (x) (cdr (assoc 41 (entget x)))) obj2)
			scl1 (apply '* scl1)
			scl2 (mapcar '(lambda (x) (cdr (assoc 42 (entget x)))) obj2)
			scl2 (apply '* scl2)
	)
	(setvar "expert" 5)
	(command ".Block" "SD_Temp_1801" "0,0" lin1 "")
	(setvar "osmode" 0)
	(command ".INSERT" "SD_Temp_1801" "X" scl1 "Y" scl2 "r" (angtos rot1 0 4) ins1)
	(setvar "osmode" OldOsmode)
	(command ".explode" (entlast))
	(command ".Purge" "B" "SD_Temp_1801" "n")
	(setvar "CmdEcho" 1)
	(command "move"  (entlast) "" pause pause)
	(SD2056)
	(setq *error* nil)
	(princ)
)
;共通コマンド
(defun SD1028 ()
  (setq OldCmdEcho (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "undo" "be")
  (setq OldOsmode (getvar "OSMODE"))
  (setq OldLayer (getvar "CLAYER"))
  (setq OldLType (getvar "CeLType"))
  (setq OldCeLWeight (getvar "CeLWeight"))
  (setq OldColor (getvar "CeColor"))
  (setq OldOrtho (getvar "ORTHOMODE"))
  (setq OldDStyle  (getvar "DIMSTYLE"))
  (setq OldExpert (getvar "Expert"))
  (setvar "EXPERT" 0)
  (setq Path_Lang "HKEY_CURRENT_USER\\Software\\SpeedDraftLT")
  (if (vl-registry-read Path_Lang "SD_Language" )
  	(setq SD:Lang (vl-registry-read Path_Lang "SD_Language" ))
  	(progn	(setq SD:Lang "J")
  			(vl-registry-write Path_Lang "SD_Language" "J")
  	)
  )
  (princ)
)
;********************************
(defun SD2056 ()
  (setvar "OSMODE" OldOsmode)
  (command "undo" "end")
  (setvar "CLAYER" OldLayer)
  (setvar "CeLType" OldLType)
  (setvar "CeLWeight" OldCeLWeight)
  (setvar "CeColor" OldColor)
  (setvar "ORTHOMODE" OldOrtho)
  (setvar "Expert" OldExpert)
  (if (and (/= (getvar "DIMSTYLE") OldDStyle)(tblsearch "DIMSTYLE" OldDStyle))
  	(command "-dimstyle" "Restore" OldDStyle)
  )
  (princ "\n (C)OffshoreCad&Management")
  (setvar "CMDECHO" OldCmdEcho)
  (princ)
)
;********************************
(defun *myerror* (msg)
	(setq *error* nil)
	(SD2056)
	(princ "\n Error in SpeedDraftLT")
	(princ)
)
;;*************************************************************************
(defun *myerror_1610*(msg)
	(command "erase" ss2 "")
	(setq *error* nil)
	(SD2056)
	(princ "\n Error in SD_2007")
)
(if (= SD:Lang "E")
	(princ "\n Command Name: SD_1610 Copy Objects on Xref or Block\n")
	(princ "\n コマンド名：SD_1610 外部参照・ブロック上の図形をコピー\n")
)
(princ)