[SD_3103] 親子扉

親子扉を作成するAutoLISPコマンドです。
開口を2点指示した後、2つのうちの1つの扉巾を入力します。

扉を作成する側及び左右の開き勝手は、マウスの位置で決定します。マウスの位置によってクルクルと扉が変わりますので、希望の位置で決定してください。

AutoLISPソース

(defun c:sd_3103 (/		   ACT		DCL_ID	 FCT	  DIS1	   DIS2
				  LBL_WIDTH			*MODELSPACE*	  BASEY	   BLJ
				  DIS1	   DIS2		ITSLAYER P1		  P2	   P3
				  P4	   PLOBJ	PM		 PTLST1	  PTLST2   PTLST3
				  PTLST4   THEANG	BASEY	 DELTA	  DIST1	   DIST2
				  P1	   P2		PT0		 PTLST	  PTLST1   PTLST2
				  PTLST3   PTLST4	PTX		 THEANG	  THEY	   NEWPOINTL
				  POINT
				 )
	(if (= SD:Lang "E")
		(princ "\n [SD_3103 ver.20220913] Door (Semi double). Press [F1] for help")
		(princ "\n [SD_3103 ver.20220913] 親子開きドア。 [F1]で使い方説明")
	)
	(princ "\n **********************************")
	(load "SD_U")
	(OpeningRoutine)
	(setfunhelp "C:SD_3103" "https://www.offshorecad.com.ph/speeddraft/blog/sd_3103/")
	
	(setq theKeyWord (Get_LAyer "A41" T))
	(setvar "osmode" 33)
	(initget 1)
	(if (= SD:Lang "E")
		(setq p1 (trans (getpoint "\n Pick first point.") 1 0))
		(setq p1 (trans (getpoint "\n 1点目を指示： ") 1 0))
	)
	(initget 1)
	(if (= SD:Lang "E")
		(setq p2 (trans (getpoint p1 "\n Pick second point.") 1 0))
		(setq p2 (trans (getpoint p1 "\n 2点目を指示： ") 1 0))
	)
	(show_SD_3103 (distance p1 p2))
	(if (= PlanMode "BasicPlan")
		(setq theColor "ByLayer")
		(setq theColor "5")
	)
	(make_3103)

	(ClosingRoutine)
	(setq *error* nil)
	(princ)
)
 ;*******
(defun make_3103 ()
;;;	(setq ItsLayer (nth 2 (SD:LayKey "DOOR")))
  (setq	theAng (angle p1 p2)
		BaseY  (cadr (SD1862 p1 theAng))
		p3	   (polar p1 (+ theAng (* 0.5 pi)) dis1)
		p4	   (polar p2 (+ theAng (* 0.5 pi)) dis2)
		pM	   (polar p1 theAng dis1)
		ptLst1 (PointConvert (list p1 p3 pM p4  p2))
		
		p3	   (polar p1 (+ theAng (* 1.5 pi)) dis1)
		p4	   (polar p2 (+ theAng (* 1.5 pi)) dis2)
		ptLst2 (PointConvert (list p1 p3 pM p4  p2))
		
		p3	   (polar p1 (+ theAng (* 0.5 pi)) dis2)
		p4	   (polar p2 (+ theAng (* 0.5 pi)) dis1)
		pM	   (polar p1 theAng dis2)
		ptLst3 (PointConvert (list p1 p3 pM p4  p2))

		p3	   (polar p1 (+ theAng (* 1.5 pi)) dis2)
		p4	   (polar p2 (+ theAng (* 1.5 pi)) dis1)
		ptLst4 (PointConvert (list p1 p3 pM p4  p2))
		
		blj	   (* -1(getBlj (* pi 0.5)))
  )
  
  (setq OrigColor (getvar "cecolor"))
  (setvar "clayer" theKeyWord)
;  (princ "\n theColor :  ")(princ theColor)
  (setvar "cecolor" theColor)
  (setq	plObj (vla-addLightweightPolyline
				*ModelSpace*
				ptLst1
			  )
  )
  (vla-setbulge plobj 1  blj)
  (vla-setbulge plobj 2   blj)
  
  (setvar "cecolor" OrigColor)
  
  (GrRead_3103)
  
)
;*******
(defun GrRead_3103 ()
  (while (and (/= (car ptX) 3) )
	(setq result (vl-catch-all-apply
				   '(lambda	()
					  (setq	ptX	(grread T 1 2)
					  )
					)
				 )
	)
	(if	(vl-catch-all-error-p result)
	  (progn
		(vla-delete plObj)
		(vl-exit-with-error "")
	  )
	)
	(if	(listp (cadr PtX))
	  (progn
		(setq pt0	(trans (cadr PtX) 1 0)
			  theY	(cadr (SD1862 pt0 theAng))
			  Delta	(- theY BaseY)
			  Dist1	(distance pt0 p1)
			  Dist2	(distance pt0 p2)
		)
		(cond ((and (<= 0 Delta) (<= Dist1 Dist2))
			   (setq ptLst ptLst1
					 blj   (* -1 (getBlj (* pi 0.5)))
			   )
			  )
			  ((and (<= 0 Delta) (>= Dist1 Dist2))
			   (setq ptLst ptLst3
					 blj   (* -1 (getBlj (* pi 0.5)))
			   )
			  )
			  ((and (>= 0 Delta) (<= Dist1 Dist2))
			   (setq ptLst ptLst2
					 blj   (getBlj (* pi 0.5))
			   )
			  )
			  ((and (>= 0 Delta) (>= Dist1 Dist2))
			   (setq ptLst ptLst4
					 blj   (getBlj (* pi 0.5))
			   )
			  )
		)
		(vla-put-Coordinates plObj ptLst)
		(vla-setbulge plobj 1 blj)
		(vla-setbulge plobj 2 blj)
	  )
	)
  )
)
 ;************
(defun getBlj (ang / blj)
  (setq blj (/ (sin (/ ang 4)) (cos (/ ang 4))))
  blj
)
 ;************
(defun show_SD_3103	(lbl_Width)
	(setq dcl_id (load_dialog "SD_3103.dcl"))
  	(if (= SD:Lang "E")
  		(new_dialog "SD_3103" dcl_id)
  		(new_dialog "SD_3103_J" dcl_id)
  	)
  
  (Registry_Read_3103)
  (RegistryRead_PlanMode)
  
(set_tile "PlanMode" PlanMode)
  (set_tile	"lbl_Width"
			(if (= SD:Lang "E")
				(strcat "Distance bet. corners : " (rtos lbl_Width 2 4))
				(strcat "距離： " (rtos lbl_Width 2 4))
			)
  )
  (set_tile "txt_Door1" txt_Door1)
  
  (action_tile "btn_2_1" "(setq fct 2)(setDist_3103)")
  (action_tile "btn_3_1" "(setq fct 3)(setDist_3103)")

  (action_tile
	"accept"
	"(get_data_3103)(setq Act 1)(done_dialog )"
  )
  (action_tile
	"cancel"
	"(setq Act 0)(done_dialog)"
  )
	(action_tile "help" "(startapp \"explorer\" \"https://www.offshorecad.com.ph/speeddraft/blog/sd_3103/\")")

  (start_dialog)
  (unload_dialog dcl_id)
  
  (if (= Act 0)
	(exit)
	
  )
  (princ)
)
;;;;*****************
(defun get_data_3103 ()
	(setq	dis1 (distof (get_tile "txt_Door1"))
			dis2 (- lbl_Width dis1)
	)
	(setq PlanMode (get_tile "PlanMode"))
	(setq txt_Door1 (get_tile "txt_Door1"))
	
	(Write_Registry_3103)
	(RegistryWrite_PlanMode)

)
;;;;*****************
(defun setDist_3103	()
  (if (not fct)
	(setq fct 2)
  )
  (setq ds1 (* fct (/ lbl_Width (+ fct 1))))
  (set_tile "txt_Door1" (rtos ds1 2 4))
)
;;;;*****************
(defun chkWdt_3103 ()
  (if (>= (distof (get_tile "txt_Door1")) lbl_Width)
  	(if (= SD:Lang "E")
		(alert (strcat "Value must be less than " (rtos lbl_Width 2 4)))
		(alert (strcat "値の上限： " (rtos lbl_Width 2 4)))
	)
  )
)
;*****
(defun Registry_Read_3103()
  (setq	Path_3103 "HKEY_CURRENT_USER\\Software\\SpeedDraft\\SD_3103" )
  (if (vl-registry-read Path_3103 "txt_Door1")
	(setq txt_Door1 (vl-registry-read Path_3103 "txt_Door1"))
	(setq txt_Door1 "")
  )
 )
 ;*****************; RegistryRead
(defun RegistryRead_PlanMode ()
	(setq Path_PM "HKEY_CURRENT_USER\\Software\\SpeedDraft\\SD_PlanMode")
	(if 	(vl-registry-read Path_PM "PlanMode" )
		(setq  PlanMode (vl-registry-read Path_PM "PlanMode" ))
		(setq PlanMode "BasicPlan")
	)
)
;*****
(defun Write_Registry_3103()
	(if txt_Door1 (vl-registry-write Path_3103 "txt_Door1" txt_Door1))
)
;*****************; RegistryWrite
(defun RegistryWrite_PlanMode ()
	(vl-registry-write Path_PM "PlanMode" PlanMode )
)
(princ)