;Nov.20.2025



  ;座標求積
  ;******************* ポリラインの頂点座標
  (defun C:SelectSiteID (/ Obj0 Ent0 Obj MyHandle ObjLength )
  ;******************* Nov.20.2025
    (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)
  );



  ;******************* ;行間隔調整サブルーチン
  (Defun RegistRowsRate ( /   )
  ;******************* Nov.20.2025
    (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図面で更新する
  (defun C:OverwritePtName ( / FileID )
  ;******************* Nov.20.2025
    (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で出力する
  ;******************* ;三斜求積
  (defun C:SelectSiteTriangle (/ Obj0 Ent0 Obj MyHandle ObjLength )
  ;******************* Nov.20.2025
    (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)
  );


















  ;選択した線分の長さを一括表記
  ;******************* ;ヘロン求積
  (defun C:SelectSiteHeron (/ Obj0 Ent0 Obj MyHandle ObjLength )
  ;******************* Nov.20.2025
    (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)
)



