


;座標求積
;ポリラインの頂点座標
;+++++++++++++ Nov.20.2025
(defun C:SelectSiteID (/ Obj0 Ent0 Obj MyHandle ObjLength )
;+++++++++++++
  (RegistRowsRate);行間隔調整サブルーチン
  (if (setq FileID (open "C:/MyCANAL/Supply/Text/SiteID.csv" "w")) ;書込みモードで開く  
    (progn   ;もしファイルを開けたら 
      (princ "\n敷地線を選択")
      (setq Obj (ssget (list (cons 0 "LWPOLYLINE,POLYLINE"))))
      ;(setq Obj (ssget '((0 . "LWPOLYLINE,POLYLINE"))));<---これでもOK
      ;----------------------
      (if (not(= Obj nil));選択されていたら・・・
        ;(if (AND(equal  MyLayer  "SiteLine") (= (cdr (assoc 0 Ent)) "LWPOLYLINE,POLYLINE"));敷地線
        (progn
          (setq cnt 0)
          (setq num (sslength Obj))
          (Command "OsnapCoord" "1" "-Layer" "M" "SiteID" "")
          (setq 文字高 (* (atof (getenv "座標文字高")) (atof (getenv "倍率"))))
          (while (< cnt num)
              (setq MyEnt (ssname Obj cnt))
              (setq Ent (entget MyEnt))
              (setq MyHandle  (cdr (assoc 5 Ent)));ハンドル名
              (setq MyLayer (cdr (assoc 8 Ent)));画層名 
              ;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
              (setq MyHandle  (cdr (assoc 5 Ent)));ハンドル名      
              (setq npsu (cdr (assoc 90 Ent)));頂点数
              (setq Pnt Ent)
              (setq nc 0)
              (repeat npsu
                  (setq MyNum (+ nc 1))	
                  (setq MyPtName (Strcat "Pt-" (itoa MyNum )))
                  (setq Pt (cdr (assoc 10 Pnt)));LWPOLYLINEの頂点座標を取得
                  ;+++++++
                  (setq Pt (trans Pt  MyEnt 0));OCS座標からWCS座標に変換
                  (setq Pt (trans Pt  0 1));WCS座標からUCS座標に変換
                  ;+++++素地
                  (setq Xp0 (car Pt)
                            Yp0 (cadr Pt))		
                  ;+++++作図単位による調整
                  (setq Xp (rtos (* Xp0 (atof (Getenv "係数")))))
                  (setq Yp (rtos (* Yp0 (atof (Getenv "係数")))))
                  ;+++++小数点揃え
                  (setq Xp (rtos (atof Xp) 2 (Atoi (Getenv "小数点"))))
                  (setq Yp (rtos (atof Yp) 2 (Atoi (Getenv "小数点"))))
                  ;+++++++
                  (setq Xp0 (rtos Xp0 ))
                  (setq Yp0 (rtos Yp0 ))
                  (setq Pt (strcat Xp0 "," Yp0))
                  ;-------------------		
                  (Command "ID" Pt "Ucs" "w" "-MText" "@" "J" "ML" 
                                "H" (rtos 文字高) "L" "A" 行間隔 "@0,0" 
                                  MyPtName 
                                  (Strcat "X=" Xp)
                                  (Strcat "Y=" Yp) "")
                  (Command "Ucs" "p")
                  ;------------------- 
                  (if (= nc 0)
                      (setq LastPt (list Pt))
                      (setq LastPt (append LastPt (list Pt)))
                  );if
                  ;-------------------
                  (setq MyPnt (assoc 10 Pnt))
                  (setq Pnt (member MyPnt Pnt))
                  (setq Pnt (cdr Pnt))
                  ;-------------
                  (setq TextObj (ssget "_L"))
                  (setq MyEnt2 (ssname TextObj 0))
                  (setq Ent2 (entget MyEnt2))
                  ;-------------
                  (setq MyTextHandle  (cdr (assoc 5 Ent2)));ハンドル名;
                  (setq MyLayer2 (cdr (assoc 8 Ent2)));画層名
                  ;-------------
                  (setq 小数点 (getenv "小数点"))
                  (setq MyString (strcat MyLayer2 "," MyTextHandle "," MyPtName "," Xp "," Yp "," 小数点))
                  (write-line MyString FileID) 
                  ;-------------
                  (setq nc (+ nc 1))
              );repeat	
              (setq cnt (1+ cnt))
          );while
          (close FileID)
        );progn 
        (alert "選択エラー");ポリラインが選択されていなかったら・・・  
      );if
      ;(alert "選択エラー");ポリラインが選択されていなかったら・・・       
      ;);if      
    );progn
    (alert "ファイルエラー");Csvが存在していなかったら・・・   
  );;if
  (princ)
);


;行間隔調整サブルーチン
;******************* Nov.20.2025
(Defun RegistRowsRate ( /   )
;*******************
   ;+++++++
	(setq 行間隔 (Getenv "行間隔"))
	(if (= 行間隔 nil);・・・Pn が nil のとき
		(progn
			(Setenv "行間隔" "0.75")
			(setq 行間隔 "0.75x")
		);progn
		(progn
			(if  (OR (< (atof 行間隔) 0.25) (> (atof 行間隔) 4.00))
				(progn
					(Setenv "行間隔" "0.75")
					(setq 行間隔 "0.75x")
				);progn
				(setq 行間隔 (strcat 行間隔 "x"))
			);if
		);progn
	);if
	;+++++++
	(princ)
);------------










;アプリで修正した測点Pt名をAutoCAD図面で更新する
;+++++++++++++Nov.20.2025
(defun C:OverwritePtName ( / FileID )
;+++++++++++++
  (if (setq FileID (open "C:/MyCANAL/Supply/Text/OverwritePtName.txt" "r")) ;読み込みモードで開く
    (progn   ;もしファイルを開けたら 
        (while
          (setq MyString (read-line FileID)) ;文字列最終行まで１行ずつ読み込む。
          ;(setq DataList (cons MyDist DataList));MyDistをDataList化する
          (setq MyVal (vl-string-search "," MyString));検索
          (setq  MyHandle (substr MyString 1 MyVal));ハンドル名
          ;(princ MyHandle)
          (setq MyVal (+ MyVal 2))
          (setq  MyPt (substr MyString MyVal));測点名
          ;(princ (strcat MyHandle "," MyPt))
          (command "select" (handent MyHandle) "")
          ;-------------
          (setq Obj (ssget "_P"));直前選択
          (setq MyEnt (ssname Obj 0))
          (setq Ent (entget MyEnt))
          ;-------------
          (setq orgText (cdr(assoc 1 Ent)))
          ;(princ orgText)
          (setq MyVal (vl-string-search "\PX" orgText));検索
          ;(princ MyVal)
          (setq  MyText (substr orgText MyVal))
          ;(princ MyText)
          (setq  NewText (strcat MyPt  MyText))
          ;--------TextObj 1 の情報（文字列）を書き換え
          (setq Ent (subst (cons 1 NewText) (assoc 1 Ent) Ent)) 
          (entmod Ent);TextObjのDXF図形情報書き換え
          ;--------
          (princ "\n")
        );while 
        ;---------------        
        (close FileID);ファイルを閉じる
      	(command "Grips" "2")
    );progn
    (alert "ファイルが見つかりませんでした") ;開けなかったら場合はこのメッセージを出す
  );if
  (princ)
);defun










;三斜求積
;選択した敷地に底辺長/高さ長を記入し、情報をcsvで出力する
;選択した線分の長さを一括表記
;+++++++++++++Nov.26.2025
(defun C:SelectSiteTriangle (/ Obj0 Ent0 Obj MyHandle ObjLength )
;+++++++++++++
  (if (setq FileID (open "C:/MyCANAL/Supply/Text/SiteTriangle.csv" "w")) ;書込みモードで開く  
    (progn   ;もしファイルを開けたら 
      (princ "\n敷地を全選択")
      (setq Obj (ssget (list (cons 0 "LINE,TEXT"))))
      ;(setq Obj (ssget '((0 . "LINE,TEXT"))));<---これでもOK
      ;----------------------
      (if (not(= Obj nil));線分/テキストが選択されていたら・・・
        (progn
          (setq cnt 0)
          (setq num (sslength Obj))
          (setq 文字高 (* (atof (getenv "長さ文字高")) (atof (getenv "倍率"))))
          (while (< cnt num)
            (setq MyEnt (ssname Obj cnt))
            (setq Ent (entget MyEnt))
            (setq MyHandle  (cdr (assoc 5 Ent)));ハンドル名
            (setq MyLayer (cdr (assoc 8 Ent)));画層名
            (cond
              ;//////////////////////////////////////////////
              ((= (cdr (assoc 0 Ent)) "LINE");----------------------   
                (if (OR (equal  MyLayer  "TriangleBase")(equal  MyLayer  "TriangleHeight"))
                  (progn
                    ;-----始点座標
                    (setq Pt1 (cdr(assoc 10 Ent)))
                    (setq Pt1 (trans Pt1  MyEnt 0));OCS座標からWCS座標に変換
                    (setq PtX1 (car Pt1)
                          PtY1 (cadr Pt1))		
                    ;-----終点座標
                    (setq Pt2 (cdr(Assoc 11 Ent)))
                    (setq Pt2 (trans Pt2  MyEnt 0));OCS座標からWCS座標に変換
                    (setq PtX2 (car Pt2)
                          PtY2 (cadr Pt2))	
                    ;-----中点座標
                    (setq PtXm (/ (+ PtX1 PtX2) 2)
                          PtYm (/ (+ PtY1 PtY2) 2))
                    (setq PtXm (rtos PtXm )
                          PtYm (rtos PtYm ))
                    (setq Ptm (strcat PtXm "," PtYm))
                    ;-----回転角度θ(rad)
                    (setq dx (- PtX2 PtX1)
                              dy (- PtY2 PtY1))
                    (setq θ (atan dy dx));rad
                    (if (> θ (/ PI 2));θ>90°
                              (setq θ (- θ PI)))
                    (if (< θ (/ PI -2));θ<-90°
                              (setq θ (+ θ PI)))
                    ;(setq deg ( / (* θ 180) PI))
                    ;-------------
                    ;(Command "dist" Pt1 Pt2)
                    ;(setq ObjLength (getvar "distance"))
                    (setq ObjLength (distance Pt1 Pt2))
                    (setq ObjLength (* ObjLength (atof (getenv "係数"))));+++++++作図単位による調整 Number
                    (setq ObjLength (rtos ObjLength 2 (atoi (getenv "小数点"))));+++++++小数点揃え String
                    ;-------------
                    (if (equal  MyLayer  "TriangleBase")
                      (Command "OsnapCoord" "1" "-Layer" "M" "TriangleBaseTxt" "")
                      (Command "OsnapCoord" "1" "-Layer" "M" "TriangleHeightTxt" "")
                    );if
                    (Command
                        "Ucs" "w"
                        "ID" Ptm                      
                        "-Text" "J" "BC" "@" (rtos 文字高) "0"
                        ;(rtos θ)
                        ObjLength;String      
                        "Grips" "2"
                        "Ucs" "p"
                        "Grips" "2")
                    ;-------------
                    (setq TextObj (ssget "_L"))
                    (setq MyEnt (ssname TextObj 0))
                    (setq Ent (entget MyEnt))
                    ;-------------
                    (setq MyTextHandle  (cdr (assoc 5 Ent)));ハンドル名
                    ;--------TextObj 50 の情報（角度）を書き換え
                    (setq Ent (subst (cons 50 θ) (assoc 50 Ent) Ent)) 
                    (entmod Ent);TextObjのDXF図形情報書き換え
                    ;--------
                    (setq 小数点 (getenv "小数点"))
                    (setq MyString (strcat MyLayer "," ObjLength "," 小数点))
                    (write-line MyString FileID)   
                  );progn
                );if
              );"LINE"
              ;//////////////////////////////////////////////
              ((= (cdr (assoc 0 Ent)) "TEXT");
                (if (equal  MyLayer  "TriangleMember")
                  (progn
                    (setq MyText (cdr(assoc 1 Ent)))
                    (setq MyString (strcat MyLayer "," MyText ))
                    (write-line MyString FileID)   
                  )
                );
              );TEXT
              ;//////////////////////////////////////////////
            );cond
            (setq cnt (1+ cnt))
          );while
          (close FileID)
        );progn
        (alert "選択エラー");線分が選択されていなかったら・・・       
      );if      
    );progn
    (alert "ファイルエラー");Csvが存在していなかったら・・・   
  );;if
  (princ)
);

















;ヘロン求積
;選択した線分の長さを一括表記
;+++++++++++++Nov.26.2025
(defun C:SelectSiteHeron (/ Obj0 Ent0 Obj MyHandle ObjLength )
;+++++++++++++
  (if (setq FileID (open "C:/MyCANAL/Supply/Text/SiteHeron.csv" "w")) ;書込みモードで開く  
    (progn   ;もしファイルを開けたら 
      (princ "\n敷地を全選択")
      (setq Obj (ssget (list (cons 0 "LINE,LWPOLYLINE,POLYLINE,TEXT"))))
      ;(setq Obj (ssget '((0 . "LINE,LWPOLYLINE,POLYLINE,TEXT"))));<---これでもOK
      ;----------------------
      (if (not(= Obj nil));選択されていたら・・・
        (progn
          (setq cnt 0)
          (setq num (sslength Obj))
          (Command "OsnapCoord" "1" "-Layer" "M" "HeronLength" "")
          (setq 文字高 (* (atof (getenv "長さ文字高")) (atof (getenv "倍率"))))
          (while (< cnt num)
            (setq MyEnt (ssname Obj cnt))
            (setq Ent (entget MyEnt))
            (setq MyHandle  (cdr (assoc 5 Ent)));ハンドル名
            (setq MyLayer (cdr (assoc 8 Ent)));画層名
            (cond
              ;///////////////////////////////////////////////
              ((= (cdr (assoc 0 Ent)) "LINE");  
                (if (equal  MyLayer  "HeronDivide");分割線   
                  (progn  
                    ;-----始点座標
                    (setq Pt1 (cdr(assoc 10 Ent)))
                    ;+++++++
                    (setq Pt1 (trans Pt1  MyEnt 0));OCS座標からWCS座標に変換
                    ;(setq Pt1(trans Pt1  0 1));WCS座標からUCS座標に変換
                    ;+++++++
                    (setq PtX1 (car Pt1)
                          PtY1 (cadr Pt1))		
                    ;-----終点座標
                    (setq Pt2 (cdr(Assoc 11 Ent)))
                    ;+++++++
                    (setq Pt2 (trans Pt2  MyEnt 0));OCS座標からWCS座標に変換
                    ;(setq Pt2(trans Pt2  0 1));WCS座標からUCS座標に変換
                    ;+++++++
                    (setq PtX2 (car Pt2)
                          PtY2 (cadr Pt2))	
                    ;-----中点座標
                    (setq PtXm (/ (+ PtX1 PtX2) 2)
                          PtYm (/ (+ PtY1 PtY2) 2))
                    (setq PtXm (rtos PtXm )
                          PtYm (rtos PtYm ))
                    (setq Ptm (strcat PtXm "," PtYm))
                    ;-----回転角度θ(rad)
                    (setq dx (- PtX2 PtX1)
                              dy (- PtY2 PtY1))
                    (setq θ (atan dy dx));rad
                    (if (> θ (/ PI 2));θ>90°
                              (setq θ (- θ PI)))
                    (if (< θ (/ PI -2));θ<-90°
                              (setq θ (+ θ PI)))
                    ;(setq deg ( / (* θ 180) PI))
                    ;-------------
                    ;(Command "dist" Pt1 Pt2)
                    ;(setq ObjLength (getvar "distance"))
                    (setq ObjLength (distance Pt1 Pt2))
                    (setq ObjLength (* ObjLength (atof (getenv "係数"))));+++++++作図単位による調整 Number
                    (setq ObjLength (rtos ObjLength 2 (atoi (getenv "小数点"))));+++++++小数点揃え String
                    ;-------------
                    (Command
                        "Ucs" "w"
                        "ID" Ptm                      
                        "-Text" "J" "BC" "@" (rtos 文字高) "0"
                        ;(rtos θ)
                        ObjLength;String      
                        "Grips" "2"
                        "Ucs" "p"
                        "Grips" "2")
                    ;-------------
                    (setq TextObj (ssget "_L"))
                    (setq MyEnt (ssname TextObj 0))
                    (setq Ent (entget MyEnt))
                    ;-------------
                    (setq MyTextHandle  (cdr (assoc 5 Ent)));ハンドル名
                    ;--------TextObj 50 の情報（角度）を書き換え
                    (setq Ent (subst (cons 50 θ) (assoc 50 Ent) Ent)) 
                    (entmod Ent);TextObjのDXF図形情報書き換え
                    ;--------
                    (setq 小数点 (getenv "小数点"))
                    (setq MyString (strcat MyLayer "," ObjLength "," 小数点))
                    (write-line MyString FileID)   
                  );progn
                );if
              );"LINE"
              ;///////////////////////////////////////////////
              ((= (cdr (assoc 0 Ent)) "TEXT");
                (if (equal  MyLayer  "HeronMember");三角形名称   
                  (progn
                    (setq MyText (cdr(assoc 1 Ent)))
                    (setq MyString (strcat MyLayer "," MyText ))
                    (write-line MyString FileID)   
                  )
                );
              );TEXT
              ;///////////////////////////////////////////////             
              (OR (equal (cdr (assoc 0 Ent)) "LWPOLYLINE") (equal (cdr (assoc 0 Ent)) "POLYLINE");   
                (if (equal  MyLayer  "HeronSite");敷地線   
                  (progn
                    (setq MyFlag  (cdr (assoc 70 Ent)));ポリライン フラグ
                    ;------
                    (setq npsu (cdr (assoc 90 Ent));頂点数
                            Pnt Ent
                            nc 0)
                    (repeat npsu;頂点数
                      (setq Pt (cdr (assoc 10 Pnt));LWPOLYLINEの頂点座標を取得
                            Pt (trans Pt  MyEnt 0);OCS座標からWCS座標に変換
                            ;Pt (trans Pt  0 1);WCS座標からUCS座標に変換
                            )      
                      ;------ 
                      (setq Ptx (car Pt)
                            Pty (cadr Pt))
                      (setq MyPnt (assoc 10 Pnt)
                            Pnt (member MyPnt Pnt)
                            Pnt (cdr Pnt))
                      (if (= nc 0)
                        (progn
                            (setq LastPt (list Pt))
                            (setq Pt1 Pt			
                                    PtX1 Ptx
                                    PtY1 Pty)
                            (setq Pt0 Pt;始点定義			
                                    PtX0 Ptx
                                    PtY0 Pty)
                        );progn
            
                        (progn;nc<>0
                          (setq LastPt (append LastPt (list Pt)))
                          (setq Pt2 Pt			
                                  PtX2 Ptx
                                  PtY2 Pty)
                          ;中点座標
                          ;+++++++++++++
                          (setq PtXm (/ (+ PtX1 PtX2) 2)
                                  PtYm (/ (+ PtY1 PtY2) 2))                          
                          (setq PtXm (rtos PtXm )
                                  PtYm (rtos PtYm ))
                          (setq Ptm (strcat PtXm "," PtYm))
                          ;-----回転角度θ(rad)
                          (setq dx (- PtX2 PtX1)
                                    dy (- PtY2 PtY1))
                          (setq θ (atan dy dx));rad
                          (if (> θ (/ PI 2));θ>90°
                                    (setq θ (- θ PI)))
                          (if (< θ (/ PI -2));θ<-90°
                                    (setq θ (+ θ PI)))
                          ;(setq deg ( / (* θ 180) PI))
                          ;-------------
                          (setq ObjLength (distance Pt1 Pt2))    
                          (setq ObjLength (* ObjLength (atof (getenv "係数"))));+++++++作図単位による調整 Number
                          (setq ObjLength (rtos ObjLength 2 (atoi (getenv "小数点"))));+++++++小数点揃え String
                          ;-------------
                          (Command
                              "Ucs" "w" 
                              "ID" Ptm
                              "-Text" "J" "BC" "@" (rtos 文字高) "0"
                              ;(rtos θ)
                              ObjLength;String      
                              "Grips" "2"
                              "Ucs" "p"
                              "Grips" "2")
                          ;-------------
                          (setq TextObj (ssget "_L"))
                          (setq MyEnt2 (ssname TextObj 0))
                          (setq Ent2 (entget MyEnt2))
                          ;-------------
                          (setq MyTextHandle  (cdr (assoc 5 Ent2)));ハンドル名
                          ;--------TextObj 50 の情報（角度）を書き換え
                          (setq Ent2 (subst (cons 50 θ) (assoc 50 Ent2) Ent2)) 
                          (entmod Ent2);TextObjのDXF図形情報書き換え
                          ;--------
                          (setq 小数点 (getenv "小数点"))
                          (setq MyString (strcat MyLayer "," ObjLength "," 小数点))
                          (write-line MyString FileID)   
                          ;-------------
                          (setq Pt1 Pt			
                                  PtX1 Ptx
                                  PtY1 Pty)
                        );progn
                      );if
                      (setq nc (+ nc 1))
                    );repeat
                    ;-------------
                    (if (= MyFlag 1);閉じたポリライン
                      (progn
                        ;中点座標
                        ;+++++++++++++
                        (setq PtXm (/ (+ PtX1 PtX0) 2)
                                PtYm (/ (+ PtY1 PtY0) 2))                          
                        (setq PtXm (rtos PtXm )
                                PtYm (rtos PtYm ))
                        (setq Ptm (strcat PtXm "," PtYm))
                        ;-----回転角度θ(rad)
                        (setq dx (- PtX0 PtX1)
                                  dy (- PtY0 PtY1))
                        (setq θ (atan dy dx));rad
                        (if (> θ (/ PI 2));θ>90°
                                  (setq θ (- θ PI)))
                        (if (< θ (/ PI -2));θ<-90°
                                  (setq θ (+ θ PI)))
                        ;(setq deg ( / (* θ 180) PI))
                        ;-------------
                        (setq ObjLength (distance Pt1 Pt0))    
                        (setq ObjLength (* ObjLength (atof (getenv "係数"))));+++++++作図単位による調整 Number
                        (setq ObjLength (rtos ObjLength 2 (atoi (getenv "小数点"))));+++++++小数点揃え String
                        ;-------------
                        (Command
                            "Ucs" "w"
                            "ID" Ptm
                            "-Text" "J" "BC" "@" (rtos 文字高) "0"
                            ;(rtos θ)
                            ObjLength;String      
                            "Grips" "2"
                            "Ucs" "p"
                            "Grips" "2")
                        ;-------------
                        (setq TextObj (ssget "_L"))
                        (setq MyEnt2 (ssname TextObj 0))
                        (setq Ent2 (entget MyEnt2))
                        ;-------------
                        (setq MyTextHandle  (cdr (assoc 5 Ent2)));ハンドル名
                        ;--------TextObj 50 の情報（角度）を書き換え
                        (setq Ent2 (subst (cons 50 θ) (assoc 50 Ent2) Ent2)) 
                        (entmod Ent2);TextObjのDXF図形情報書き換え
                        ;--------
                        (setq 小数点 (getenv "小数点"))
                        (setq MyString (strcat MyLayer "," ObjLength "," 小数点))
                        (write-line MyString FileID)   
                        ;-------------
                      );progn
                    );if
                  );progn
                );if
              );LWPOLYLINE
              ;///////////////////////////////////////////////
            );cond
            (setq cnt (1+ cnt))
          );while
          (close FileID)
        );progn
        (alert "選択エラー");線分が選択されていなかったら・・・       
      );if      
    );progn
    (alert "ファイルエラー");Csvが存在していなかったら・・・   
  );;if
  (princ)
);

















(defun c:qqq ( / )
  (if (setq FileID (open "C:/MyCANAL/Supply/Text/SiteTriangle.csv" "w")) ;書込みモードで開く  
    (progn   ;もしファイルを開けたら 
      (princ "\n文字を選択")
      (setq Obj (ssget (list (cons 0 "LINE,TEXT"))))

      (setq cnt 0)
      (setq num (sslength Obj))
      (setq 文字高 (* (atof (getenv "長さ文字高")) (atof (getenv "倍率"))))
      (while (< cnt num)
        (setq MyEnt (ssname Obj cnt))
        (setq Ent (entget MyEnt))
        (setq MyHandle  (cdr (assoc 5 Ent)));ハンドル名
        (setq MyLayer (cdr (assoc 8 Ent)));画層名
        (if (equal  MyLayer  "TriangleMember")
          (progn
            (setq MyText (cdr(assoc 1 Ent)))
            (setq MyString (strcat MyLayer "," MyText ))
            (write-line MyString FileID) 
          )
                   
        )
        (setq cnt (1+ cnt)) 
      )
      (close FileID)
    )
  )
  (princ)
)
















;+++++++++++++
;(defun C:SelectTriangleSite ( / Flg Obj Ent0 TextObj LineObj  θ)
  (defun c:zzz ( / )
;+++++++++++++


   ;角度を指定してDXF図形情報をLineObjに登録 
   (setq Pt1 (getpoint "\n1点目を指定："))
   (setq Pt2 (getpoint "\n2点目を指定："))
   (setq Pt1 (trans Pt1  1 0));UCS座標からWCS座標に変換
   (setq Pt2 (trans Pt2  1 0));UCS座標からWCS座標に変換
   (setq θ (angle Pt1 Pt2));rad

   (if (and (> θ (/ PI 2))(<= θ PI));90°<θ<=180°
      (setq θ (+ θ PI)))
   (if (and (> θ PI)(< θ (* PI 1.5)));180°<θ<270°
      (setq θ (- θ PI)))
   (setq Mydeg ( / (* θ 180) PI))
   (Command "OsnapCoord" "1" "-Layer" "M" "TriangleBase" "")
   (Command "line" Pt1 Pt2 "")

   (princ)
)



