;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_1708 ( / ObjNameL MadeObjL LastOb)
	(if (= SD:Lang "E")
		(princ "\n Intersect polylines")
		(princ "\n ポリライン重なり部分を作成")
	)
	(princ "\n **********************************")
	(setq *error* *myerror*)   
	(SD1028)
	
	(setq ObjSet nil)
	(while (= ObjSet nil)
		(setq ObjSet (ssget '((-4 . "<OR")
								(0 . "LWPOLYLINE")
								(0 . "ELLIPSE")
								(0 . "CIRCLE")
								(0 . "POLYLINE")
								(0 . "LINE")
								(0 . "ARC")
							(-4 . "OR>"))
					)
		)
	)
	
	;選択セットから図形名のリスト作成
	(setq i -1 ObjNameL nil)
	(repeat (setq m (sslength ObjSet))
			(setq ObjNameL (cons  (ssname ObjSet (setq i (1+ i))) ObjNameL))
	)
	
	(Procedure_1708 ObjNameL)	;Regionの作成
	
	(Procedure_1708_2 MadeObjL)	;Union
	
	(SD2056)
	(setq *error* nil)
	(princ)
)

;*********;Union
(defun Procedure_1708_2( ObjL / )
	(command ".intersect")
	(mapcar 'command MadeObjL)
	(command "")
	
	;分解	
	(setq LastOb (entlast) MadeObjL nil)
	(command ".EXPLODE" (entlast))

	;作成されたObjのリスト
	(while (setq LastOb (entnext LastOb))
		(setq MadeObjL (cons LastOb MadeObjL))
	)

	;再びポリライン化
	(command ".PEDIT" "M")
	(mapcar 'command MadeObjL)
	(command "" "Y" "J" "0.000" "")
)

;*********;Regionの作成
(defun Procedure_1708( ObjL / )

	(setq LastOb (entlast))
	(command ".region")
	(mapcar 'command ObjNameL)
	(command "")
	
	;作成されたObjのリスト
	(while (setq LastOb (entnext LastOb))
		(setq MadeObjL (cons LastOb MadeObjL))
	)
	MadeObjL
)
;共通コマンド
(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)
)
(if (= SD:Lang "E")
	(princ "\n Command Name: SD_1708 Intersect polylines\n")
	(princ "\n コマンド名：SD_1708 ポリライン重なり部分を作成\n")
)
(princ)
