;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_1703 ( / Flag ObjName ObjType VLAObj Flag_1703 Pt0 Param
					Data PtN m Pos Pos2 DataA DataB NewData)
	
	(if (= SD:Lang "E")
		(princ "\n remove vertex of polyline")
		(princ "\n ポリライン頂点削除")
	)
	(princ "\n **********************************")
	(setq *error* *myerror_1703*)	
	(SD1028)
	
	(setq Flag nil)
	(while (null Flag)		;FlagがTになるまで続く
		(setq ObjName nil ObjType nil)
		(if (= SD:Lang "E")
			(setq ObjName (car (setq ObjPt (entsel	"\n Select Polyline to delete point from :"))))
			(setq ObjName (car (setq ObjPt (entsel	"\n 頂点を削除したいポリラインを指示： "))))
		)
		(if ObjName (setq ObjType (SD3511 0 ObjName))(setq Flag nil))
		(if (= ObjType "LWPOLYLINE")(setq Flag T))
	)

	(setq VLAObj  (vlax-ename->vla-object ObjName))
	(redraw ObjName 3)

	(setvar "OSMODE" 1)
	
	(setq Flag_1703 nil)
	(while (null Flag_1703)
		(if (= SD:Lang "E")
			(setq Pt0 (getpoint "\n Click vertex to delete"))
			(setq Pt0 (getpoint "\n 削除する頂点を指示： "))
		)
		(setq Param (vlax-curve-getParamAtPoint VLAObj (trans Pt0 1 0)))
		(if 	(null Param)
			(if (= SD:Lang "E")
				(princ "\n Not on the Polyline")
				(princ "\n ポリライン上にありません")
			)
			(setq Flag_1703 T)
		)
	)
	
;	(princ "\n Param :  ")(princ Param)
	
	(setq Data (entget ObjName))
	(setq PtN (SD3511 90 Data))
;	(mapcar 'print Data)
	
	(setq m -1 n 0)
	(foreach Item Data
		(setq n (1+ n))
		(if (= (car item) 10)
			(setq m (1+ m))
		)
		(if 	(= m Param)
			(setq Pos n)
		)
	)
	(setq Pos2 (- Pos 4))

	(setq 	DataA (ListCut1 Data Pos2)
			DataB (ListCut Data Pos)
	)
	(setq NewData (append DataA DataB))
	(setq NewData (subst (cons 90 (1- PtN))(assoc 90 NewData)NewData))
	(entmod NewData)
;	(mapcar 'print NewData)	

	(redraw ObjName 4)
	
	(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 SD3511 (g e)
	(cond
		((= (type e) 'ename) (cdr (assoc g (entget e))))
		((= (type e) 'list) (cdr (assoc g e)))
	)
)
;***リストをn番目で分割して前半を取得****************************************************************
(defun ListCut1 (SD_List SD_n / SD_List_N)
	(setq m 0)
	(repeat SD_n
		(setq SD_List_N (append SD_List_N (list (nth m SD_List))))
		(setq m (1+ m))
	)
	SD_List_N
)

;***リストをn番目で分割して後半を取得****************************************************************
(defun ListCut (SD_List SD_n / SD_List_N)
	(repeat (- (length SD_List) SD_n)
		(setq SD_List_N (append SD_List_N (list (nth SD_n SD_List))))
		(setq SD_n (1+ SD_n))
	)
	SD_List_N
)
;********
(defun *myerror_1703* (msg)
	(redraw ObjName 4)
	(setq *error* nil)
	(SD2056)
	(princ "\n Error in SpeedDraft 1702")
)
(if (= SD:Lang "E")
	(princ "\n Command Name: SD_1703 remove vertex of polyline\n")
	(princ "\n コマンド名：SD_1703 ポリライン頂点削除\n")
)
(princ)