[SD_6208] ガラス記号

窓ガラスの各種記号を記入するAutoLISPコマンドです。
下記のような６種類の記号を作図します。
窓ガラスの領域内を１点クリックするだけで領域を検出して作図しますので、作図が早いです。
6番の引違い記号については、窓ガラスの左側をクリックすると左側に、右側尾クリックすると右側に記号を作図します。
作図されるマークの大きさがおかしいと感じたら、USERR1の値をチェックしてください。縮尺1/50の図面でしたら、USERR1を50としてください。

AutoLISPソース

(defun c:SD_6208 ()
	(if (= SD:Lang "E")
		(princ "\n [SD_6208 ver.20221216] Glass mark on window ellevation")
		(princ "\n [SD_6208 ver.20221216] サッシの立面にガラス記号を付加")
	)
	(princ "\n **********************************")
	(load "SD_U")
	(setq *error* *myerror*)
	(OpeningRoutine)
	(setq Typ (getvar "users1"))
	(if (= SD:Lang "E")
		(setq Typ2 Typ)
		(cond 	((= Typ "Glass")(setq Typ2 "ガラス記号"))
				((= Typ "F")(setq Typ2 "FIX記号"))
				((= Typ "Mirror")(setq Typ2 "鏡"))
				((= Typ "Swing")(setq Typ2 "片開き記号"))
				((= Typ "Slide")(setq Typ2 "引き戸矢印"))
				((= Typ "Slide both")(setq Typ2 "引違い記号"))
		)
	) 
	(if (= SD:Lang "E")
		(princ (strcat "\n Door Swing Marks (" Typ2 ")"))
		(princ (strcat "\n 扉の記号 (" Typ2 ")"))
	)
	(princ "\n **********************************")
	(setvar "osmode" 0)

	(if (= Typ "Swing")
			(if (= SD:Lang "E")
				(setq 	pp1 (getpoint "\n Click Hinge Side"))
				(setq 	pp1 (getpoint "\n 領域内の1点を指示：クリックした側がヒンジ側となります"))
			)
			(if (= SD:Lang "E")
				(setq 	pp1 (getpoint "\n Select internal point: "))
				(setq 	pp1 (getpoint "\n 領域内の1点を指示： "))
			)
	)
	(setq TheLayer (Get_Layer "A83" T))
	(if (= (getvar "clayer")TheLayer)
		(setvar "clayer" "0")
	)
	(command "-layer" "off" TheLayer "")
	(Make_Sash pp1 Typ 0)
	(command "-layer" "on" TheLayer "")
	
	(ClosingRoutine)
	(setq *error* nil)
	(princ)
)
;;************************************************************
(defun Make_Sash (pp1 Typ ofset / 	pp1 obj1 obj BoxPt pnt1 pnt2 TheLayer p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15 p16 p17 p18 p19 p20 p21)
	(command ".boundary" "_non" pp1 "")
	(setq 	obj1 (vlax-ename->vla-object (entlast))
	      	obj (vla-getboundingbox obj1 'MinPoint 'MaxPoint)
	     	 	BoxPt (list (vlax-safearray->list MinPoint)(vlax-safearray->list MaxPoint))
	      	pnt1 (nth 0 BoxPt)
	      	pnt2 (nth 1 BoxPt)
	      	pnt3 (list (car pnt2)(cadr pnt1))
	      	mid1 (polar pnt1 (angle pnt1 pnt2) (/ (distance pnt1 pnt2) 2))
	      	TheLayer (Get_Layer "A83" T)
	)
	(entdel (entlast))
	(setq 	p1 (polar (polar pnt1 (* 0.25 pi) (* 0.4 (getvar "USERR1"))) (* 0.75 pi) (* 0.4 (getvar "USERR1")))
			p2 (polar p1 (* 0.25 pi) (* 2 (getvar "USERR1")))
			p3 (polar p1 (* 1.75 pi) (* 0.8 (getvar "USERR1")))
			p4 (polar p2 (* 1.75 pi) (* 0.8 (getvar "USERR1")))
			
			p5 (polar (polar pnt2 (* 1.25 pi) (* 0.4 (getvar "USERR1"))) (* 1.75 pi) (* 0.4 (getvar "USERR1")))
			p6 (polar p5 (* 1.25 pi) (* 2 (getvar "USERR1")))
			p7 (polar p5 (* 0.75 pi) (* 0.8 (getvar "USERR1")))
			p8 (polar p6 (* 0.75 pi) (* 0.8 (getvar "USERR1")))
			
			p9 (polar (polar pnt3 (* 1.0 pi) (* (getvar "USERR1") 2.5)) (* 0.5 pi) (* (getvar "USERR1") 2.5))
			
			p10 (polar pnt1 (* 0.5 pi) (/ (distance pnt2 pnt3) 2))
			
			p11 (polar mid1 0.0 (* 1.5 (getvar "USERR1")))
			p12 (polar mid1 (* 1.0 pi) (* 1.5 (getvar "USERR1")))
			p13 (polar p12 (/ (* 0.5 pi) 6.0) (* 2 (getvar "USERR1")))
			
			p15 (polar (polar (polar pnt3 (* 0.5 pi)(/ (distance pnt3 pnt2) 2)) 0.0 ofset) 0.0 (* 3.0(getvar "USERR1")))
			p14 (polar p15 (+ (* 1.0 pi) (/ (* 0.5 pi) 6.0)) (* 2.0 (getvar "USERR1")))
			p16 (polar p15 (* 1.0 pi) (* 6 (getvar "USERR1")))
			p17 (polar p16 (/ (* 0.5 pi) 6.0) (* 2.0 (getvar "USERR1")))
			
			p19 (polar mid1 0.0 (* 1.5 (getvar "USERR1")))
			p18 (polar p19 (- (* 1.0 pi) (/ (* 0.5 pi) 6.0)) (* 1 (getvar "USERR1")))
			p20 (polar p19 (* 1.0 pi) (* 3 (getvar "USERR1")))
			p21 (polar p20 (/ (* 0.5 pi) 6.0) (* 1 (getvar "USERR1"))))
	(cond
		((or (= Typ "Glass")(= Typ "Mirror"))
			(SD:MakeLine p1 p2 TheLAyer)
			(SD:MakeLine p3 p4 TheLAyer)
			(SD:MakeLine p5 p6 TheLAyer)
			(SD:MakeLine p7 p8 TheLAyer)
			(if (= Typ "Mirror") (SD:MakeText "鏡" p9 (* (getvar "USERR1") 2.5) 0.0 TheLAyer))
		)
		((= Typ "F")
			(SD:MakeText "F" mid1 (* (getvar "USERR1") 2.5) 0.0 TheLAyer))
		((= Typ "Swing")
			(setvar "celtype" (Get_Ltype "TS1"))
			(SD:MakePline (list pnt3 p10 pnt2) nil TheLayer 0)
			(setvar "celtype" "ByLayer")
			(if (and (> (angle mid1 pp1)(* 0.5 pi))(< (angle mid1 pp1)(* 1.5 pi)))
				()(command "rotate" (entlast)"" mid1 "180")
			)
		)
		((= Typ "Slide")
			(SD:MakePline (list p11 p12 p13) nil TheLayer 0)
			(if (and (> (angle mid1 pp1)(* 0.5 pi))(< (angle mid1 pp1)(* 1.5 pi)))
				()(command "mirror" (entlast) "" mid1  (polar mid1 (* 0.5 pi) 10.0) "y")
			)
		)
		((= Typ "Slide both")
			(SD:MakePline (list p14 p15 p16 p17) nil TheLayer 0)
			(if (and (> (angle mid1 pp1)(* 0.5 pi))(< (angle mid1 pp1)(* 1.5 pi)))
				(command "move" (entlast) "" pnt3 pnt1)
			)
		)
		((= Typ "Bypass")
			(SD:MakePline (list p18 p19 p20 p21) nil TheLayer 0)
		)
	)
)
(princ)