;; excelToCAD2.lsp
;; 2024.09.07 f.izawa
;; 起動中の Excel のアクティブなセル範囲を CAD 上に描画します。
;; Excel 上の罫線は無視してセルごとに枠線、対角線を描画します。

;; 2023.07.02 
;;   対角線の描画を追加
;;   結合セルの枠をPOLYLINEで描いていたのを取りやめ
;;   プログレスバーの表示を追加
;; 2023.07.03A
;;   一部コードの整理（Range を都度取得していたのを修正）
;; 2023.07.03B
;;   一部コードの整理（RC表記のアドレス変換を修正）
;; 2023.07.04
;;   罫線、マージ情報を取得しないバージョンを追加（実用できる速さになった）
;;   Excel で文字基点が既定値で文字列が数値のとき、右基点にするを追加
;;   cadToExcel *LINE で作成された格子状の表の TEXT を Excel に転送を追加
;; 2023.07.05
;;   cadToExcel 
;      水平文字基点の再現を追加
;;     式が設定されているセルには文字を書き込まないに変更
;;     行高さ、列幅、文字サイズの再現を追加
;;     処理が重くなったのでプログレスバーを追加
;;   cadToClipBrd CAD 上の表文字列をクリップボードにコピーを追加
;; 2023.07.09
;;    Excel からのデータ取得を外部 EXE で行うバージョンを追加
;;    ※ 注意！外部 EXE を経由すると半角￥(A5H)がバックスラッシュ(5CH)に置き換わる
;; 2023.07.10
;;    excelToCadEx 不要な幅表示をコメントアウト、罫線取得を対角線のみに変更
;; 2023.07.17
;;    EXE を ifs_excelToCad2.exe（レイトバインディング版） に変更
;;    ZwCAD に対応

;; 2024.09.07
;;    Excel の FontSize が取得出来ない時、エラーになるのを対策

(vl-load-com)
(defun c:xx()
    ;;; アクティブな文字スタイルのフォント情報を検索して、フォントの太字を変える例。
    ; CharSet パラメータはフォントの文字セットを指定する。

    ; Public Const ANSI_CHARSET = 0
    ; Public Const DEFAULT_CHARSET = 1
    ; Public Const SYMBOL_CHARSET = 2
    ; Public Const SHIFTJIS_CHARSET = 128
    ; Public Const OEM_CHARSET = 255
    ; PitchAndFamily パラメータは、フォントのピッチおよびファミリの値を指定する。 
    ; 値は 3 つの別々な設定の組み合わせにより決定する。 
    ; PitchAndFamily の値を提供するには、各分類から設定を選択し、次に OR 演算子を使用してこれらを結合する。 
    ; 最初の 2 つのカテゴリ、つまりピッチおよびファミリは必ず指定する。 
    ; 3 番目のカテゴリ、TrueType Flag は、TrueType フォントを指定するときだけに使用する。

    ; VB または VBA アプリケーションで次の定数を使用するには、コードの宣言セクションに定義をコピーする。

    ; ' Pitch Values
    ; Public Const DEFAULT_PITCH = 0
    ; Public Const FIXED_PITCH = 1
    ; Public Const VARIABLE_PITCH = 2
    ; ' Family Values
    ; Public Const FF_DONTCARE = 0    '  Don't care or don't know.
    ; Public Const FF_ROMAN = 16      '  Variable stroke width, serifed.
    ; Public Const FF_SWISS = 32      '  Variable stroke width, sans-serifed.
    ; Public Const FF_MODERN = 48     '  Constant stroke width, serifed or sans-serifed.
    ; Public Const FF_SCRIPT = 64     '  Cursive, etc.
    ; Public Const FF_DECORATIVE = 80 '  Old English, etc.
    ; ' TrueType Flag
    ; Public Const TMPF_TRUETYPE = &H4
    (setq *actdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 
    (vla-getfont (vla-get-ActiveTextStyle *actdoc*) 'typeFace 'Bold 'Italic 'charSet 'PitchandFamily)
     
    (alert (strcat "現在の文字スタイルは、以下のフォントプロパティ:"
                   "\n書体: " typeFace
                   "\n太字: " (if (= Bold :vlax-true) "True" "False")
                   "\n斜体: " (if (= Italic :vlax-true) "True" "False")
                   "\n文字セット: " (itoa charSet)
                   "\nピッチとファミリー: " (itoa PitchandFamily)))
             
    ;;; 太字に変更
    (setq Bold (if (= Bold :vlax-true) :vlax-false :vlax-true))
 
    (vla-SetFont (vla-get-ActiveTextStyle *actdoc*) typeFace Bold Italic charSet PitchandFamily)
   
    (alert (strcat "現在の文字スタイルは、以下のフォントプロパティ:"
                   "\n書体: " typeFace
                   "\n太字: " (if (= Bold :vlax-true) "True" "False")
                   "\n斜体: " (if (= Italic :vlax-true) "True" "False")
                   "\n文字セット: " (itoa charSet)
                   "\nピッチとファミリー: " (itoa PitchandFamily)))
             
    ;;; フォントのリセット
    (setq Bold (if (= Bold :vlax-true) :vlax-false :vlax-true))
    (vla-SetFont (vla-get-ActiveTextStyle *actdoc*) typeFace Bold Italic charSet PitchandFamily)
)

; (defun c:xx()
;   (setq ticks (getvar "DATE"))
;   (setq 
;     acad (vlax-get-acad-object)
;     docs (vla-get-Documents acad)
;   )
;   (setq n (vla-get-Count docs))
;   ;; タイトルと図番を順に取得
;   (setq i 0)
;   (repeat n 
;     (setq doc (vla-Item docs i))
;     ;; ドキュメントの名前
;     ;;(vla-get-Name doc)
;     (princ "\ndocName : ")(princ (vla-get-Name doc))
;     (setq i (1+ i))
;   )
;   (princ "\n")
;   (princ (fix (* (- (getvar "DATE") ticks) 86400000))) ;24 60 60 1000)))
;   (princ)
; )
; (defun c:zz( / wshShell)
;   ; (atoms-family 0 (list "acet-sys-spawn"))
;   ; (setq product (strcase (getvar "PRODUCT")))
;   (setq wshShell (vlax-get-or-create-object "Wscript.Shell"))
;   (vlax-invoke-method wshShell 'Run "notepad.exe xxx.txt" 1 :vlax-true)
;   ;;オブジェクトが解放されている場合は T を、解放されていない場合は nil 
;   (princ (vlax-object-released-p wshShell))
;   (vlax-release-object wshShell )
;   (alert "終了しました")
;   (princ)
; )
; (defun c:xx( / excelApp workSheet xlsRun range)
;   (if (setq excelApp (ifs_get_excelApp))
;     (if (setq worksheet (ifs_get_workSheet excelApp))
;       (setq xlsRun T)
;     )
;   )
;   (if xlsRun
;     (progn
;       (setq range (vlax-get-property worksheet 'Range "A1"))
;       (if (not (vlax-object-released-p range))
;         (vlax-release-object range)
;       )
;     )
;   )
;   (ifs_free_excelApp excelApp worksheet)
;   (princ)
; )

;; 罫線、マージ情報を取得しないバージョン
(defun c:excelToCad()
  (ifs_do_excelToCad nil nil)
)
;; 罫線、マージ情報を取得するバージョン（かなり遅い）
(defun c:excelToCadEx()
  (ifs_do_excelToCad T T)
)

(defun ifs_do_excelToCad( brdFlag mrgFlag / excelapp worksheet xlsRun area col edcol edrow vrange row stcol 
            strow txrows szcols szrows txcols 
            alrows alcols colWidths rowHeights
            h i len w x y  j str txh align txof txofsc txsc xsc ysc 
            chklst k lst mgcnt y0 p1 p2 p3 p4
            edpt mergenow mergeold stpt x1 x2 y1 y2 y3 y4
            doc mspc vpt vtext ss layerTable item lays ticks
            lncols lnrows mgcols mgrows dimsc)
  
  (defun makevline (pt1 pt2 laysIndex / vline)
    (setq vline (vla-addline mspc (vlax-3d-point pt1)(vlax-3d-point pt2)))
    (vla-put-layer vline (nth laysIndex lays))
    (setq ss (ssadd (vlax-vla-object->ename vline) ss))         
  )
  (defun addvline (pt1 pt2 layindex / len i len pt3 pt4 ent fuz pts cnt 
                   ename ename1 ename2 ent1 ent2 pt1a pt1b pt2a pt2b )
    (setq fuz 0.000001 cnt 0)
    (setq len (sslength ss) i 0)
    (repeat len
      (setq 
        ename (ssname ss i) ent (entget ename)
        pt3 (cdr (assoc 10 ent)) pt4 (cdr (assoc 11 ent))
      )
      (if (and pt3 pt4)
        (if (ifs_isDouitsu pt1 pt2 pt3 pt4)
          (if (or (equal pt1 pt3 fuz)(equal pt1 pt4 fuz))
            (setq ename1 ename ent1 ent pt1a pt3 pt1b pt4)
            (if (or (equal pt2 pt3 fuz)(equal pt2 pt4 fuz))
              (setq ename2 ename ent2 ent pt2a pt3 pt2b pt4)
            )
          )
        )
      )
      (setq i (1+ i))
    )
    (if (and ename1 ename2)
      (progn
        (setq 
          pts (ifs_maxDist2p (list pt1 pt2 pt1a pt1b pt2a pt2b))
          ent1 (subst (cons 10 (car  pts)) (assoc 10 ent1) ent1)
          ent1 (subst (cons 11 (cadr pts)) (assoc 11 ent1) ent1)
          cnt (1+ cnt)
        )
        (entmod ent1)
        (setq ss (ssdel ename2 ss))
        (entdel ename2)
      )
      (if ename1
        (progn
          (setq 
            pts (ifs_maxDist2p (list pt1 pt2 pt1a pt1b))
            ent1 (subst (cons 10 (car  pts)) (assoc 10 ent1) ent1)
            ent1 (subst (cons 11 (cadr pts)) (assoc 11 ent1) ent1)
            cnt (1+ cnt)
          )
          (entmod ent1)
        )
        (if ename2
          (progn
            (setq 
              pts (ifs_maxDist2p (list pt1 pt2 pt2a pt2b))
              ent2 (subst (cons 10 (car  pts)) (assoc 10 ent2) ent2)
              ent2 (subst (cons 11 (cadr pts)) (assoc 11 ent2) ent2)
              cnt (1+ cnt)
            )
            (entmod ent2)        
          )
        )
      )
    )
    (if (= cnt 0)
       (makevline pt1 pt2 layindex)
    )
  )
  
  (defun my_error(msg)
    (princ msg)
    (ifs_free_excelApp excelApp worksheet)
    (setq txrows nil lnrows nil mgrows nil szrows nil alrows nil rowHeights nil colWidths nil)
    (gc)
    
    (setq *error* nil)
    (princ)
  )
  (setq *error* my_error)
  
  ;; 設定 -----------------------------------
  (setq 
    xsc (/ 6.0 13.5)     ;; セルの線、罫線の X 方向の尺度 
    ysc (/ 6.0 13.5)     ;; セルの線、罫線の Y 方向の尺度 
    txsc (/ 2.5 11.0)     ;; 文字高さの尺度（Excel ｍ文字サイズ 11 のとき CAD 上の 2.5 mm になる）
    txofsc 0.75 ;; 左、右基点のオフセット（文字高さ＊0.75 の余白）
  )
  ;; ---------------------------------------
  (setq
    lays (list "ExcelLine" "ExcelText");; 2 番目が Text用
  )
  (setq 
    dimsc (getvar "DIMSCALE")
    xsc (* xsc dimsc)
    ysc (* ysc dimsc)
    txsc (* txsc dimsc)
  )
 	(setq 
 		doc (vla-get-ActiveDocument (vlax-get-acad-object))
 		mspc (vla-get-ModelSpace doc)
    ss (ssadd)
  )
  ;; 画層作成
  (setq layerTable (vla-get-Layers doc))
  (foreach item lays
    (vla-Add layerTable item)
  )
  ;; Excel を見つける
  (if (setq excelApp (ifs_get_excelApp))
    (if (setq worksheet (ifs_get_workSheet excelApp))
      (setq xlsRun T)
    )
  )                
  (if xlsRun
    (progn
      (princ "\nデータ取得中 ")
      ;; データ取得
      (setq 
        area (ifs_get_activeRangeArea excelApp)
        strow (car area) stcol (cadr area) edrow (caddr area) edcol (cadddr area)
      )
      (if (and (>= (length area) 2)(> strow 0)(> stcol 0))
        (progn
          (setq ticks (getvar "DATE"))
          (acet-ui-progress-init "Excelのデータを取得中"  (1+ (- edrow strow)))
          (if (= (length area) 2)
            (setq edrow strow edcol stcol)
          )
          (setq row strow txrows nil mgrows nil szrows nil alrows nil lnrows nil rowHeights nil colWidths nil)
          (repeat (1+ (- edrow strow))
            (setq col stcol txcols nil mgcols nil szcols nil alcols nil lnCols nil )
            (repeat (1+ (- edcol stcol))
              (setq vrange (vlax-get-property worksheet 'Range (idx_toRangeStr row col)))
              (if (= row strow)
                (setq colWidths (append colWidths (list (ifs_get_vrangeWidth vrange))))
              )
              (if (= col stcol)
                (setq rowHeights (append rowHeights (list (ifs_get_vrangeHeight vrange))))
              )
              (setq txcols (append txcols (list (ifs_get_vrangeText vrange))))
              (setq szcols (append szcols (list (ifs_get_FontSize vrange))))
              (setq alcols (append alcols (list (ifs_get_HorizontalAlignment vrange))))
              
              (if brdFlag (setq lncols (append lncols (list (ifs_get_Borders vrange)))));; 対角線のみ使用
              (if mrgFlag (setq mgcols (append mgcols (list (ifs_get_mergeArea vrange)))))
              (setq col (1+ col))
              
            )
            (setq 
              txrows (append txrows (list txcols))
              szrows (append szrows (list szcols))
              alrows (append alrows (list alcols))
            )
            (if brdFlag (setq lnrows (append lnrows (list lncols))));; 対角線のみ使用
            (if mrgFlag (setq mgrows (append mgrows (list mgcols))))
            (setq row (1+ row))
            (acet-ui-progress row)
            (princ ".")
          )
          ;; (princ colWidths)
          (acet-ui-progress)
          (princ "\n")(princ (fix (* (- (getvar "DATE") ticks) 24 60 60 1000)))(princ " msec")
           ;; 10列 x 83行 データで bricscad 31秒；ijcad 146秒 : delphi 6秒
          ;; 2023/07/02
          ;; 10列 x 83行 データで bricscad 23秒程度に改善、IJCAD 170〜157秒と遅くなっている
          ;; 2023/07/03
          ;; 10列 x 83行 データで bricscad 18秒程度に改善、IJCAD 170〜157秒と遅くなっている
          ;; 2023/07/03
          ;; マージセル検出あり : BricsCAD 18〜26秒, IJCAD 170〜180秒程度, ZW 20秒
          ;; マージセル検出なし : BricsCAD 3.8 秒, IJCAD 12秒, ZW 5秒
        )
      )
    )
  )
  ;; 描画
  (if (and rowHeights colWidths)
    (progn
      ;; 作成基点は左上
      (setq mgcnt 0)
      (if brdFlag ;; 罫線の情報は無視している
        (progn
          (setq 
            w (apply '+ colWidths) h (apply '+ rowHeights)
            w (* w xsc) h (* h ysc)
          )
          ;; 横線
          (setq i 0 len (length rowHeights) y 0.0)
          (repeat len
            (setq 
              x 0.0
              stpt (list x y 0) edpt nil j 0
              mergeold T
            )
            (if mgRows (setq mgCols (nth i mgRows)))
            (if lnRows (setq lnCols (nth i lnRows)))

            (repeat (length colWidths)
              ;; セル左側と右側の X 座標
              (setq x1 x x2 (setq x (+ x (* (nth j colWidths) xsc))))
              (if mgcols 
                (setq mergenow (nth j mgcols))
                (setq mergenow nil)
              )
              (if mergenow (setq mgCnt (1+ mgCnt)))
              (cond
                ((and (not mergeold) mergenow )
                  (makevline stpt (setq edpt (list x1 y 0.0)) 0)
                )
                ((and mergeold (not mergenow))
                  (setq stpt (list x1 y 0.0) edpt nil)
                )
                ((and mergenow T)
                  (setq stpt (list x2 y 0.0) edpt nil)
                )
              )
              (if (and lnCols (not mergenow))
                (progn
                  ;;(princ "\nマージ無し斜線")(princ (nth j lnCols))
                  ;; 下り対角線
                  (setq y3 y y4 (- y (* (nth i rowHeights) ysc)))
                  (if (> (logand 16 (nth j lnCols)) 0)
                    (makevline (list x1 y3 0.0) (list x2 y4 0.0) 0)
                  )
                  ;; 上り対角線
                  (if (> (logand 32 (nth j lnCols)) 0)
                    (makevline (list x1 y4 0.0) (list x2 y3 0.0) 0)
                  )
                )
              )
              (setq mergeold mergenow)
              (setq j (1+ j))
            )
            (if (not edpt)
              (progn
                (setq edpt (list w y 0))
                (if (not (equal stpt edpt 0.000001));; 必要
                  (makevline stpt edpt 0)
                )
              )
            )            
            (setq y (- y (* (nth i rowHeights) ysc)))
            (setq i (1+ i))
          )
          (setq stpt (list 0 y 0) edpt (list w y 0))
          (makevline stpt edpt 0)
          ;; 縦線
          (setq i 0 len (length colWidths) x 0.0)
          (repeat len
            (setq 
              y 0.0
              stpt (list x y 0) edpt nil j 0
              mergeold T
            )
            (repeat (length rowHeights)
              ;; セルの上側と下側の Y 座標
              (setq y1 y y2 (setq y (- y (* (nth j rowHeights) ysc))))
              (if mgRows (setq mergenow (nth i (nth j mgRows))))
              (cond
                ((and (not mergeold) mergenow)
                  (makevline stpt (setq edpt (list x y1 0.0)) 0)
                )
                ((and mergeold (not mergenow))
                  (setq stpt (list x y1 0.0) edpt nil)
                )
                ((and mergenow T)
                  (setq stpt (list x y2 0.0) edpt nil)
                )
              )
              (setq mergeold mergenow)
              (setq j (1+ j))
            )
            (if (not edpt)
              (progn
                (setq edpt (list x (- h) 0))
                (if (not (equal stpt edpt 0.000001));; 必要
                  (makevline stpt edpt 0)
                )
              )
            )            
            (setq x (+ x (* (nth i colWidths) xsc)))
            (setq i (1+ i))
          )
          (setq stpt (list w 0 0) edpt (list w (- h) 0))
          (makevline stpt edpt 0)
        )
      );; end brdLine
      
      ;; TEXT 作成（結合セルのみ）------------------------
      (if (and mrgFlag (> mgcnt 0))
        (progn
          (setq i 0 y 0.0 chklst nil)
          (repeat (length rowHeights)
            (setq 
              txcols (nth i txrows) 
              szcols (nth i szrows)
              alcols (nth i alrows) 
              x 0.0
              y (- y (* (nth i rowHeights) ysc 0.5));;半行分下げる
              j 0
            )
            (if mgRows (setq mgcols (nth i mgrows)))
            (if lnRows (setq lncols (nth i lnRows)))
            (repeat (length colWidths)
              ;; 結合セル
              (if (and mgcols (setq lst (nth j mgcols)))
                (if (not (member lst chklst));; 空白文字のチェックを行っていないので必要
                  (progn                   
                    (setq k 0 h 0 w 0)
                    (repeat (car lst)
                      (setq h (+ h (nth (+ i k) rowHeights)))
                      (setq k (1+ k))
                    )
                    (setq k 0)
                    (repeat (cadr lst)
                      (setq w (+ w (nth (+ j k) colWidths)))
                      (setq k (1+ k))
                    )
                    (setq chklst (append chklst (list lst)))
                    ;; セル上側の基準 Y 座標 (半行分下げた分を戻した Y 座標)
                    (setq y0 (+ y (* (nth i rowHeights) ysc 0.5)))
                    (if (/= "" (setq str  (nth j txcols)))
                      (progn
                        (if (and szcols (nth j szcols))
                          (setq txh (* (nth j szcols) txsc))
                          (setq txh 2.5)
                        )
                        ;;(princ "\ntxh=")(princ txh)
                        (setq align (nth j alcols))
                        (cond
                          ((= align 2)(setq txof (* w xsc 0.5)))
                          ((= align 3)(setq txof (- (* w xsc) (* txh txofsc))))
                          (T (setq txof (* txh txofsc)))
                        )
                        (setq 
                          vpt (vlax-3d-point (list (+ x txof) (- y0 (* h ysc 0.5)) 0))
                          vtext (vla-addtext mspc str vpt txh)
                        )
                        (cond
                          ((= align 2)(vla-put-Alignment vtext acAlignmentMiddleCenter))
                          ((= align 3)(vla-put-Alignment vtext acAlignmentMiddleRight))
                          (T (vla-put-Alignment vtext acAlignmentMiddleLeft))
                        ) 
                        (vla-put-TextAlignmentPoint vtext vpt) 
                        (vla-put-layer vtext (nth 1 lays))
                        (setq ss (ssadd (vlax-vla-object->ename vtext) ss))
                      )
                    )
                    (setq 
                      p4 (list x y0 0.0) p2 (list (+ x (* w xsc)) (- y0 (* h ysc)) 0.0)
                      p1 (list (car p4)(cadr p2) 0.0) p3 (list (car p2)(cadr p4) 0.0)
                    )
                    ;; 既存の線分に合体
                    (addvline p4 p3 0)
                    (addvline p4 p1 0)
                    ;; polyline で作成
                    ; (setq pts (vlax-make-safearray vlax-vbDouble '(0 . 8))
                    ; (vlax-safearray-fill pts (append p1 p4 p3))
                    ; (setq vpline (vla-AddPolyline mspc pts))
                    ; ;;(vla-put-closed vpline :vlax-true)
                    ; (vla-put-layer vpline "ExcelLine")
                    ; (setq ss (ssadd (vlax-vla-object->ename vpline) ss))                    
                    (if lnCols
                      (progn
                        ;;(princ "\n斜め線:")(princ  (nth j lnCols))
                        ;; 下り対角線
                        (if (> (logand 16 (nth j lnCols)) 0) (makevline p4 p2 0))
                        ;; 上り対角線
                        (if (> (logand 32 (nth j lnCols)) 0) (makevline p1 p3 0))
                      )
                    )
                  )                    
                )
              )
              (setq x (+ x (* (nth j colwidths) xsc)))
              (setq j (1+ j))
            ) 
            (setq y (- y (* (nth i rowHeights) ysc 0.5)))
            (setq i (1+ i))
          )
        )
      );; end mergeText
      
      ;; TEXT 作成（結合セル以外）
      (setq i 0 y 0.0 x 0.0 mgcnt 0)
      (repeat (length rowHeights)
        (setq x 0.0)
        (setq 
          txcols (nth i txrows)
          szcols (nth i szrows)
          alcols (nth i alrows)
          y (- y (* (nth i rowHeights) ysc 0.5))
          j 0
        )
        (if mgrows (setq mgcols (nth i mgrows)))
        (repeat (length colWidths)
          (if (and szcols (nth j szcols))
            (setq txh (* (nth j szcols) txsc))
            (setq txh 2.5)
          )
          ;;(princ "\ntxh2=")(princ txh)
          (setq align (nth j alcols))
          (cond
            ((= align 2)(setq txof (* (nth j colWidths) xsc 0.5)))
            ((= align 3)(setq txof (- (* (nth j colWidths) xsc) (* txh txofsc))))
            (T (setq txof (* txh txofsc)))
          )
          (if (or (not mgcols)(and mgcols (not (nth j mgcols))));; 結合セル以外
            (if (/= "" (setq str  (nth j txcols))) 
              (progn
                (setq 
                  vpt (vlax-3d-point (list (+ x txof) y 0))
                  vtext (vla-addtext mspc str vpt txh)
                )
                (cond
                  ((= align 2)(vla-put-Alignment vtext acAlignmentMiddleCenter))
                  ((= align 3)(vla-put-Alignment vtext acAlignmentMiddleRight))
                  (T (vla-put-Alignment vtext acAlignmentMiddleLeft))
                ) 
                (vla-put-TextAlignmentPoint vtext vpt)
                (vla-put-layer vtext "ExcelText")
                (setq ss (ssadd (vlax-vla-object->ename vtext) ss))
              )
            )
            (setq mgcnt (1+ mgcnt));; マージされているセル数
          )
          (setq x (+ x (* (nth j colwidths) xsc)))
          (setq j (1+ j))
        ) 
        (setq y (- y (* (nth i rowHeights) ysc 0.5)))
        (setq i (1+ i))
      )
      
      (if (not brdFlag) ;; セルの枠線
        (progn
          ;; セルの区切り線 0,0 から右下へ作成
          (setq 
            w (apply '+ colWidths) h (apply '+ rowHeights)
            w (* w xsc) h (* h ysc)
          )
          ;; 横線
          (setq i 0 len (length rowHeights) y 0.0 x 0.0 )
          (repeat (1+ len)
            (makevline (list x y 0) (list (+ x w) y 0) 0)
            (if (< i len)
              (setq y (- y (* (nth i rowHeights) ysc)))
            )
            (setq i (1+ i))
          )
          ;; 縦線
          (setq i 0 len (length colWidths) y 0.0 x 0.0 )
          (repeat (1+ len)
            (makevline (list x y 0)(list x (- y h) 0) 0)
            (if (< i len)
              (setq x (+ x (* (nth i colWidths) xsc)))
            )
            (setq i (1+ i))
          )
        )
      );; end celLine
    )
  )
  

  (ifs_free_excelApp excelApp worksheet)
  (if (> (sslength ss) 0)
    (progn
      (setvar "CMDECHO" 0)
      (command "_COPYBASE" '(0 0 0) ss "")
      (command "_ERASE" ss "")
      (setq ss nil)
      (setvar "CMDECHO" 1)
      (command "_PASTECLIP")
    )
  )
  (setq txrows nil mgrows nil szrows nil alrows nil rowHeights nil colWidths nil)
  (gc)
  (setq *error* nil)  
  (princ)
)
;;---------------------------------------------------
;; 外部 EXE 経由で Excel の情報を取得するバージョン
;; ※ 注意！外部 EXE を経由すると半角￥(A5H)がバックスラッシュ(5CH)に置き換わる
;; 罫線、マージ情報を取得しない
(defun c:excelToCadApp()
  (ifs_do_excelToCadApp nil)
  (princ)
)
;; 罫線、マージ情報を取得する
(defun c:excelToCadAppEx()
  (ifs_do_excelToCadApp T)
  (princ)
)
(defun ifs_do_excelToCadApp( exFlag / brdFlag mrgFlag excelapp worksheet xlsRun area edcol edrow row stcol 
            strow txrows szcols szrows txcols 
            alrows alcols colWidths rowHeights
            h i len w x y  j str txh align txof txofsc txsc xsc ysc 
            chklst k lst mgcnt y0 p1 p2 p3 p4
            edpt mergenow mergeold stpt x1 x2 y1 y2 y3 y4
            doc mspc vpt vtext ss layerTable item lays ticks
            lncols lnrows mgcols mgrows dimsc lspFlag lspFullName cmd)
  
  (defun makevline (pt1 pt2 laysIndex / vline)
    (setq vline (vla-addline mspc (vlax-3d-point pt1)(vlax-3d-point pt2)))
    (vla-put-layer vline (nth laysIndex lays))
    (setq ss (ssadd (vlax-vla-object->ename vline) ss))         
  )
  (defun addvline (pt1 pt2 layindex / len i len pt3 pt4 ent fuz pts cnt 
                   ename ename1 ename2 ent1 ent2 pt1a pt1b pt2a pt2b )
    (setq fuz 0.000001 cnt 0)
    (setq len (sslength ss) i 0)
    (repeat len
      (setq 
        ename (ssname ss i) ent (entget ename)
        pt3 (cdr (assoc 10 ent)) pt4 (cdr (assoc 11 ent))
      )
      (if (and pt3 pt4)
        (if (ifs_isDouitsu pt1 pt2 pt3 pt4)
          (if (or (equal pt1 pt3 fuz)(equal pt1 pt4 fuz))
            (setq ename1 ename ent1 ent pt1a pt3 pt1b pt4)
            (if (or (equal pt2 pt3 fuz)(equal pt2 pt4 fuz))
              (setq ename2 ename ent2 ent pt2a pt3 pt2b pt4)
            )
          )
        )
      )
      (setq i (1+ i))
    )
    (if (and ename1 ename2)
      (progn
        (setq 
          pts (ifs_maxDist2p (list pt1 pt2 pt1a pt1b pt2a pt2b))
          ent1 (subst (cons 10 (car  pts)) (assoc 10 ent1) ent1)
          ent1 (subst (cons 11 (cadr pts)) (assoc 11 ent1) ent1)
          cnt (1+ cnt)
        )
        (entmod ent1)
        (setq ss (ssdel ename2 ss))
        (entdel ename2)
      )
      (if ename1
        (progn
          (setq 
            pts (ifs_maxDist2p (list pt1 pt2 pt1a pt1b))
            ent1 (subst (cons 10 (car  pts)) (assoc 10 ent1) ent1)
            ent1 (subst (cons 11 (cadr pts)) (assoc 11 ent1) ent1)
            cnt (1+ cnt)
          )
          (entmod ent1)
        )
        (if ename2
          (progn
            (setq 
              pts (ifs_maxDist2p (list pt1 pt2 pt2a pt2b))
              ent2 (subst (cons 10 (car  pts)) (assoc 10 ent2) ent2)
              ent2 (subst (cons 11 (cadr pts)) (assoc 11 ent2) ent2)
              cnt (1+ cnt)
            )
            (entmod ent2)        
          )
        )
      )
    )
    (if (= cnt 0)
       (makevline pt1 pt2 layindex)
    )
  )
  
  (defun my_error(msg)
    (princ msg)
    (ifs_free_excelApp excelApp worksheet)
    (setq txrows nil lnrows nil mgrows nil szrows nil alrows nil rowHeights nil colWidths nil)
    (gc)
    
    (setq *error* nil)
    (princ)
  )
  (setq *error* my_error)
  ;; 設定 -----------------------------------
  (setq 
    xsc (/ 6.0 13.5)     ;; セルの線、罫線の X 方向の尺度 
    ysc (/ 6.0 13.5)     ;; セルの線、罫線の Y 方向の尺度 
    txsc (/ 2.5 11.0)    ;; 文字高さの尺度（Excel ｍ文字サイズ 11 のとき CAD 上の 2.5 mm になる）
    txofsc 0.75 ;; 左、右基点のオフセット（文字高さ＊0.75 の余白）
  )
  ;; ---------------------------------------
  (setq
    lays (list "ExcelLine" "ExcelText");; 2 番目が Text用
  )
  (setq 
    dimsc (getvar "DIMSCALE")
    xsc (* xsc dimsc)
    ysc (* ysc dimsc)
    txsc (* txsc dimsc)
  )
 	(setq 
 		doc (vla-get-ActiveDocument (vlax-get-acad-object))
 		mspc (vla-get-ModelSpace doc)
    ss (ssadd)
  )
  ;; 画層作成
  (setq layerTable (vla-get-Layers doc))
  (foreach item lays
    (vla-Add layerTable item)
  )
  ;; Excel を見つける
  (if (setq excelApp (ifs_get_excelApp))
    (if (setq worksheet (ifs_get_workSheet excelApp))
      (setq xlsRun T)
    )
  )                
  (if xlsRun
    (progn
      (princ "\nExcel からデータを取得中 ...")
      (if (setq lspFullName (findfile "ifs_excelToCadResult.lsp"))
        (progn
          (princ "\n古いデータファイルを削除しています．")
          (vl-file-delete lspFullName)
        )
      )
      (setq ticks (getvar "DATE"))
      (if (= "ZWCAD" (getvar "PRODUCT"))
        (progn
          (if exFlag
            (setq cmd "ifs_excelToCad2.exe /ex")
            (setq cmd "ifs_excelToCad2.exe")
          )
          ;;(princ cmd)
          (setq wshShell (vlax-get-or-create-object "Wscript.Shell"))
          (vlax-put-property  wshShell 'CurrentDirectory (vl-filename-directory (findfile "zwcad.exe")))
          (vlax-invoke-method wshShell 'Run cmd 1 :vlax-true)
          (vlax-release-object wshShell)
        )
        (if exFlag
          (acet-sys-spawn 1 "ifs_excelToCad2.exe" "/ex")
          (acet-sys-spawn 1 "ifs_excelToCad2.exe")
        )
      )
        
      (if (findfile "ifs_excelToCadResult.lsp")
        (progn
          (princ "\n新しいデータファイルが見つかりました．")
          (load "ifs_excelToCadResult.lsp")
          (setq lspFlag T)
        )
      )
      ;; データ取得
      (setq 
        area (ifs_get_activeRangeArea excelApp)
        strow (car area) stcol (cadr area) edrow (caddr area) edcol (cadddr area)
      )
      (ifs_free_excelApp excelApp worksheet)
      (if (and lspFlag (>= (length area) 2)(> strow 0)(> stcol 0))
        (progn
          (if (= (length area) 2)
            (setq edrow strow edcol stcol)
          )
          (setq row strow txrows nil mgrows nil szrows nil alrows nil lnrows nil rowHeights nil colWidths nil)
          (setq
            txrows (setTextStr)
            szrows (setFontSize)
            alrows (setTxtAlign)
            colWidths (setColWidths)
            rowHeights (setRowHwights)
          ) 
          (if exFlag
            (setq
              lnrows (setLineBits)
              mgrows (setMerge)
              brdFlag T
              mrgFlag T
            )
          ) 
          (princ "\n")(princ (fix (* (- (getvar "DATE") ticks) 24 60 60 1000)))(princ " msec")
        )
      )
    )
  )
  ;; 描画
  (if (and rowHeights colWidths)
    (progn
      ;; 作成基点は左上
      (setq mgcnt 0)
      (if brdFlag ;; 罫線の情報は無視している
        (progn
          (setq 
            w (apply '+ colWidths) h (apply '+ rowHeights)
            w (* w xsc) h (* h ysc)
          )
          ;; 横線
          (setq i 0 len (length rowHeights) y 0.0)
          (repeat len
            (setq 
              x 0.0
              stpt (list x y 0) edpt nil j 0
              mergeold T
            )
            (if mgRows (setq mgCols (nth i mgRows)))
            (if lnRows (setq lnCols (nth i lnRows)))

            (repeat (length colWidths)
              ;; セル左側と右側の X 座標
              (setq x1 x x2 (setq x (+ x (* (nth j colWidths) xsc))))
              (if mgcols 
                (setq mergenow (nth j mgcols))
                (setq mergenow nil)
              )
              (if mergenow (setq mgCnt (1+ mgCnt)))
              (cond
                ((and (not mergeold) mergenow )
                  (makevline stpt (setq edpt (list x1 y 0.0)) 0)
                )
                ((and mergeold (not mergenow))
                  (setq stpt (list x1 y 0.0) edpt nil)
                )
                ((and mergenow T)
                  (setq stpt (list x2 y 0.0) edpt nil)
                )
              )
              (if (and lnCols (not mergenow))
                (progn
                  ;;(princ "\nマージ無し斜線")(princ (nth j lnCols))
                  ;; 下り対角線
                  (setq y3 y y4 (- y (* (nth i rowHeights) ysc)))
                  (if (> (logand 16 (nth j lnCols)) 0)
                    (makevline (list x1 y3 0.0) (list x2 y4 0.0) 0)
                  )
                  ;; 上り対角線
                  (if (> (logand 32 (nth j lnCols)) 0)
                    (makevline (list x1 y4 0.0) (list x2 y3 0.0) 0)
                  )
                )
              )
              (setq mergeold mergenow)
              (setq j (1+ j))
            )
            (if (not edpt)
              (progn
                (setq edpt (list w y 0))
                (if (not (equal stpt edpt 0.000001));; 必要
                  (makevline stpt edpt 0)
                )
              )
            )            
            (setq y (- y (* (nth i rowHeights) ysc)))
            (setq i (1+ i))
          )
          (setq stpt (list 0 y 0) edpt (list w y 0))
          (makevline stpt edpt 0)
          ;; 縦線
          (setq i 0 len (length colWidths) x 0.0)
          (repeat len
            (setq 
              y 0.0
              stpt (list x y 0) edpt nil j 0
              mergeold T
            )
            (repeat (length rowHeights)
              ;; セルの上側と下側の Y 座標
              (setq y1 y y2 (setq y (- y (* (nth j rowHeights) ysc))))
              (if mgRows (setq mergenow (nth i (nth j mgRows))))
              (cond
                ((and (not mergeold) mergenow)
                  (makevline stpt (setq edpt (list x y1 0.0)) 0)
                )
                ((and mergeold (not mergenow))
                  (setq stpt (list x y1 0.0) edpt nil)
                )
                ((and mergenow T)
                  (setq stpt (list x y2 0.0) edpt nil)
                )
              )
              (setq mergeold mergenow)
              (setq j (1+ j))
            )
            (if (not edpt)
              (progn
                (setq edpt (list x (- h) 0))
                (if (not (equal stpt edpt 0.000001));; 必要
                  (makevline stpt edpt 0)
                )
              )
            )            
            (setq x (+ x (* (nth i colWidths) xsc)))
            (setq i (1+ i))
          )
          (setq stpt (list w 0 0) edpt (list w (- h) 0))
          (makevline stpt edpt 0)
        )
      );; end brdLine
      
      ;; TEXT 作成（結合セルのみ）------------------------
      (if (and mrgFlag (> mgcnt 0))
        (progn
          (setq i 0 y 0.0 chklst nil)
          (repeat (length rowHeights)
            (setq 
              txcols (nth i txrows) 
              szcols (nth i szrows)
              alcols (nth i alrows) 
              x 0.0
              y (- y (* (nth i rowHeights) ysc 0.5));;半行分下げる
              j 0
            )
            (if mgRows (setq mgcols (nth i mgrows)))
            (if lnRows (setq lncols (nth i lnRows)))
            (repeat (length colWidths)
              ;; 結合セル
              (if (and mgcols (setq lst (nth j mgcols)))
                (if (not (member lst chklst));; 空白文字のチェックを行っていないので必要
                  (progn                   
                    (setq k 0 h 0 w 0)
                    (repeat (car lst)
                      (setq h (+ h (nth (+ i k) rowHeights)))
                      (setq k (1+ k))
                    )
                    (setq k 0)
                    (repeat (cadr lst)
                      (setq w (+ w (nth (+ j k) colWidths)))
                      (setq k (1+ k))
                    )
                    (setq chklst (append chklst (list lst)))
                    ;; セル上側の基準 Y 座標 (半行分下げた分を戻した Y 座標)
                    (setq y0 (+ y (* (nth i rowHeights) ysc 0.5)))
                    (if (/= "" (setq str  (nth j txcols)))
                      (progn
                        (if (and szcols (nth j szcols))
                          (setq txh (* (nth j szcols) txsc))
                          (setq txh 2.5)
                        )
                        ;;(princ "\ntxh3=")(princ txh)
                        (setq align (nth j alcols))
                        
                        (cond
                          ((= align 2)(setq txof (* w xsc 0.5)))
                          ((= align 3)(setq txof (- (* w xsc) (* txh txofsc))))
                          (T (setq txof (* txh txofsc)))
                        )
                        (setq 
                          vpt (vlax-3d-point (list (+ x txof) (- y0 (* h ysc 0.5)) 0))
                          vtext (vla-addtext mspc str vpt txh)
                        )
                        (cond
                          ((= align 2)(vla-put-Alignment vtext acAlignmentMiddleCenter))
                          ((= align 3)(vla-put-Alignment vtext acAlignmentMiddleRight))
                          (T (vla-put-Alignment vtext acAlignmentMiddleLeft))
                        ) 
                        (vla-put-TextAlignmentPoint vtext vpt) 
                        (vla-put-layer vtext (nth 1 lays))
                        (setq ss (ssadd (vlax-vla-object->ename vtext) ss))
                      )
                    )
                    (setq 
                      p4 (list x y0 0.0) p2 (list (+ x (* w xsc)) (- y0 (* h ysc)) 0.0)
                      p1 (list (car p4)(cadr p2) 0.0) p3 (list (car p2)(cadr p4) 0.0)
                    )
                    ;; 既存の線分があれば合体
                    (addvline p4 p3 0)
                    (addvline p4 p1 0)
                    ;; polyline で作成
                    ; (setq pts (vlax-make-safearray vlax-vbDouble '(0 . 8))
                    ; (vlax-safearray-fill pts (append p1 p4 p3))
                    ; (setq vpline (vla-AddPolyline mspc pts))
                    ; ;;(vla-put-closed vpline :vlax-true)
                    ; (vla-put-layer vpline "ExcelLine")
                    ; (setq ss (ssadd (vlax-vla-object->ename vpline) ss))                    
                    (if lnCols
                      (progn
                        ;; 下り対角線
                        (if (> (logand 16 (nth j lnCols)) 0) (makevline p4 p2 0))
                        ;; 上り対角線
                        (if (> (logand 32 (nth j lnCols)) 0) (makevline p1 p3 0))
                      )
                    )
                  )                    
                )
              )
              (setq x (+ x (* (nth j colwidths) xsc)))
              (setq j (1+ j))
            ) 
            (setq y (- y (* (nth i rowHeights) ysc 0.5)))
            (setq i (1+ i))
          )
        )
      );; end mergeText
      
      ;; TEXT 作成（結合セル以外）
      (setq i 0 y 0.0 mgcnt 0)
      (repeat (length rowHeights)
        (setq x 0.0)
        (setq 
          txcols (nth i txrows)
          szcols (nth i szrows)
          alcols (nth i alrows)
          y (- y (* (nth i rowHeights) ysc 0.5))
          j 0
        )
        (if mgrows (setq mgcols (nth i mgrows)))
        (repeat (length colWidths)
          (setq txh (* (nth j szcols) txsc) align (nth j alcols))
          (cond
            ((= align 2)(setq txof (* (nth j colWidths) xsc 0.5)))
            ((= align 3)(setq txof (- (* (nth j colWidths) xsc) (* txh txofsc))))
            (T (setq txof (* txh txofsc)))
          )
          (if (or (not mgcols)(and mgcols (not (nth j mgcols))));; 結合セル以外
            (if (/= "" (setq str  (nth j txcols))) 
              (progn
                ; '\' 5CH->A5H
                ; (if (vl-string-search (chr 92) str)
                ;   (setq str (ifs_string_replace (chr 165) (chr 92) str))
                ; )
                (setq 
                  vpt (vlax-3d-point (list (+ x txof) y 0))
                  vtext (vla-addtext mspc str vpt txh)
                )
                (cond
                  ((= align 2)(vla-put-Alignment vtext acAlignmentMiddleCenter))
                  ((= align 3)(vla-put-Alignment vtext acAlignmentMiddleRight))
                  (T (vla-put-Alignment vtext acAlignmentMiddleLeft))
                ) 
                (vla-put-TextAlignmentPoint vtext vpt)
                (vla-put-layer vtext "ExcelText")
                (setq ss (ssadd (vlax-vla-object->ename vtext) ss))
              )
            )
            (setq mgcnt (1+ mgcnt));; マージされているセル数
          )
          (setq x (+ x (* (nth j colwidths) xsc)))
          (setq j (1+ j))
        ) 
        (setq y (- y (* (nth i rowHeights) ysc 0.5)))
        (setq i (1+ i))
      )
      
      (if (not brdFlag) ;; セルの枠線
        (progn
          ;; セルの区切り線 0,0 から右下へ作成
          (setq 
            w (apply '+ colWidths) h (apply '+ rowHeights)
            w (* w xsc) h (* h ysc)
          )
          ;; 横線
          (setq i 0 len (length rowHeights) y 0.0 x 0.0 )
          (repeat (1+ len)
            (makevline (list x y 0) (list (+ x w) y 0) 0)
            (if (< i len)
              (setq y (- y (* (nth i rowHeights) ysc)))
            )
            (setq i (1+ i))
          )
          ;; 縦線
          (setq i 0 len (length colWidths) y 0.0 x 0.0 )
          (repeat (1+ len)
            (makevline (list x y 0)(list x (- y h) 0) 0)
            (if (< i len)
              (setq x (+ x (* (nth i colWidths) xsc)))
            )
            (setq i (1+ i))
          )
        )
      );; end celLine
    )
  )
  (ifs_free_excelApp excelApp worksheet)
  (if (> (sslength ss) 0)
    (progn
      (setvar "CMDECHO" 0)
      (command "_COPYBASE" '(0 0 0) ss "")
      (command "_ERASE" ss "")
      (setq ss nil)
      (setvar "CMDECHO" 1)
      (command "_PASTECLIP")
    )
  )
  (setq txrows nil mgrows nil szrows nil alrows nil lnrows nil rowHeights nil colWidths nil)
  (gc)
  (setq *error* nil)  
  (princ)
)



;; excel ---------------------------------------------
(defun ifs_get_excelApp( / excelAPP xlsrun)
  (setq 
    excelApp (vlax-get-or-create-object "Excel.Application")
    xlsrun (vlax-get-property excelApp 'Visible)
  )
  (if (= xlsrun :vlax-true)
    (princ (strcat "\nExcel が見つかりました．[" (vlax-get-property excelApp 'Caption) "]"))
    (progn
      (princ "\n有効な Excel が見つかりません．")
      (vlax-release-object excelApp)
      (setq excelApp nil)
    )
  )
  excelApp
)

(defun ifs_get_workSheet(excelApp / worksheet)
  (if (not (setq worksheet (vlax-get-property excelApp 'ActiveSheet)))
    (progn
      (princ "\n有効な WorkSheet が見つかりません．")
      (vlax-release-object excelApp)
      (setq excelApp nil)
      (gc)
    )
  )
  worksheet
)

(defun ifs_free_excelApp(excelApp worksheet / )
  (if (and worksheet (not (vlax-object-released-p worksheet)))
    (vlax-release-object worksheet)
  )
  (if (and excelApp (not (vlax-object-released-p excelApp)))
    (vlax-release-object excelApp)
  )
  (setq worksheet nil excelApp nil)
)

;; 内部値（表示とは異なる）を取得（値が無いときは nil が返る）
(defun ifs_get_rangeValue(worksheet range)
  (vlax-variant-value (vlax-get-property (vlax-get-property worksheet 'Range range) 'Value2))
)

;; 表示どおりの文字として取得
(defun ifs_get_rangeText(worksheet range)
  (vlax-variant-value (vlax-get-property (vlax-get-property worksheet 'Range range) 'Text))
)
(defun ifs_get_vrangeText(vrange)
  (vlax-variant-value (vlax-get-property vrange 'Text))
)
;; 値を格納（文字列、数値関係なし）
(defun ifs_put_rangeValue(worksheet range value)
  (vlax-put-property (vlax-get-property worksheet 'Range range) 'Value2 (vlax-make-variant value))
)
(defun ifs_put_vrangeValue(vrange value)
  (vlax-put-property vrange 'Value2 (vlax-make-variant value))
)
; (defun ifs_put_rangeText(worksheet range value)
;   (vlax-put-property (vlax-get-property worksheet 'Range range) 'Text (vlax-make-variant value vlax-vbString))
; )

;; row, col を "A1" 表記に変える (col は 1〜676 = "A"〜"ZZ" まで. row は最大行数 Excel2007 = 1048576 まで)
;; row, col は 1-based
(defun idx_toRangeStr(row col)
  ;; 64 = (1- (ascii "A"))
  (if (<= col 26)
    (strcat (chr (+ 64 col)) (itoa row))
    (strcat (chr (+ 64 (/ col 26))) (chr (+ (rem col 26) 64)) (itoa row))
  )
)
;; "A1:C3" 表記に
;; 引数は row col の順 row, col は 1-based
;; 未使用
(defun idx_toRangeStr2(row1 col1 row2 col2)
  (strcat (idx_toRangeStr row1 col1) ":" (idx_toRangeStr row2 col2))
)
;; Range.Clear
;; セルの値、書式、コメント全てを消去。未使用状態（初期状態）に
;; 未使用
(defun ifs_clear_range (worksheet range)
  (vlax-invoke-method (vlax-get-property worksheet 'Range range) 'Clear)
)
;; Range.ClearContents
;; 定数としての文字・数値、計算式（関数）を消去。書式（フォント、背景色、罫線等）は残る
;; 未使用
(defun ifs_clearContents_range (worksheet range)
  (vlax-invoke-method (vlax-get-property worksheet 'Range range) 'ClearContents)
)

;; startRow から値がある最後の行を取得 無い時は 0 を返す
;; col には必ず値がある列を指定すること。空白出現で終了する
;; row, col は 1-based
;; 未使用
(defun idx_dataEndRow(worksheet startRow col / i loop value endRow)
  (setq i startRow loop T endRow startRow)
  (while loop
    (setq value (ifs_get_rangeValue worksheet (idx_toRangeStr i col)))
    (if (or (= nil value) (= "" value))
      (setq loop nil endRow (1- i))
    )
    (setq i (1+ i))
  )
  endRow
)

;; 値がある最終行 無い時は 0 を返す
;; 最下行から値を検索しているため、それより上の空白は無視される
;; row, col は 1-based
(defun idx_get_lastRow( workSheet col / rowsCount range objRange lastRow)
  ;; xlDown = -4121, xlUp = -4162, xlToLeft = -4159, xlToRight = -4161 
  (setq 
    rowsCount (vlax-get-property (vlax-get-property worksheet 'Rows ) 'Count);; Excel2007 >= 1048576
    range (idx_toRangeStr rowsCount col)
    lastRow 0
  )
  (if (setq objRange (vlax-get-property (vlax-get-property worksheet 'Range range) 'End -4162));; =xlUp
    (progn
      (setq lastRow (vlax-get-property objRange 'Row))
      (vlax-release-object objRange)
    )
  )
  lastRow    
)

;; 値がある最後の行を取得 col1 .. col2 の範囲が対象 
;; col1 < col2 であること
;; 最下行から値を検索しているため、それより上の空白は無視される
;; row, col は 1-based
;; 未使用
(defun idx_get_lastRowEx (worksheet col1 col2 / i n len lastRow)
  (setq len (1+ (- col2 col1)) i 0 lastRow 0)
  (repeat len
    (setq n (idx_get_lastRow worksheet (+ col1 i)))
    (if (> n lastRow)(setq lastRow n))
    (setq i (1+ i))
  )
  lastRow
)

;; "R5C3:R10C8" のような文字列を (5 3 10 8)のリストに変換
(defun ifs_rcAddresList (rcAddress / res len i c )
  (setq len (strlen rcAddress) i 1 res "")
  (repeat len
    (setq c (substr rcAddress i 1))
    (if (or (= c "R")(= c "C"))
      (setq res (strcat res " "))
      (if (/= c ":")
        (setq res (strcat res c))
      )
    )
    (setq i (1+ i))
  )
  (mapcar 'atoi (cdr (ifs_strSplit res " " )))
)

;; アクティブなセルの範囲を得る
;; セルが１つのときは、(row col row col) の順
;; row, col は 1-based
(defun ifs_get_activeRangeArea(excelApp / address range window res)
  (setq 
    window (vlax-get-property excelApp 'ActiveWindow)
    range (vlax-get-property window 'RangeSelection)
    ;; Address([RowAbsolute], [ColumnAbsolute], [ReferenceStyle As XlReferenceStyle = xlA1], 
    ;;   [External], [RelativeTo]) As String 
    ;; xlA1 = 1, xlR1C1 = -4150 (&HFFFFEFCA)
    ;; ex : "$A$1:$F$5" または "R5C3:R10C8" のような文字列が返る
    address (vlax-get-property range 'Address nil nil -4150);; vbFalse = 0. vbTrue =-1
  )
  ; (setq s (ifs_string_replace "" ":" address))
  ; (setq s (ifs_string_replace " " "R" s))
  ; (setq s (ifs_string_replace " " "C" s))
  ; ;; 数字に変換
  ; (setq res (mapcar 'atoi (cdr (ifs_strSplit s " " ))))
  
  ;; 1000 データで 12sec -> 9 sec に短縮
  ;; 呼び出されるのは１回だけなので速度アップには貢献しない
  (setq res (ifs_rcAddresList address))
  (if (= 2 (length res))
    (setq res (append res res))
  )
  res
)
;; 行の高さ（読み取り専用）
;; ポイント単位の Double 値
;; 設定は、 RowHeight プロパティ
;; 13.5 = 18 pixel (13.5/0.75=18)
(defun ifs_get_RowHeight(worksheet row / v)
  (setq v (vlax-get-property (vlax-get-property worksheet 'Range (idx_toRangeStr row 1)) 'Height))
  (vlax-variant-value v)
)
(defun ifs_get_vrangeHeight(vrange)
  (vlax-variant-value (vlax-get-property vrange 'Height))
)

;; 列の幅
;; ポイント単位の Double 値（読み取り専用）
;; 幅を設定は ColumnWidth プロパティ
;; 60.0 = 80 pixel　0.75 倍　(60/0.75=80)
(defun ifs_get_ColWidth(worksheet col / v)
  (setq v (vlax-get-property (vlax-get-property worksheet 'Range (idx_toRangeStr 1 col)) 'Width))
  (vlax-variant-value v)
)
(defun ifs_get_vrangeWidth(vrange)
  (vlax-variant-value (vlax-get-property vrange 'Width))
)
;; 水平文字位置
;; 左=1, 中=2,　右=3 を返す
(defun ifs_get_HorizontalAlignment(vrange / hAlign res v)
  ;; xlSystem = 1, xlLeft = -4131 (&HFFFFEFDD), xlCenter = -4108 (&HFFFFEFF4),  xlRight = -4152 (&HFFFFEFC8)
  (setq hAlign (vlax-variant-value (vlax-get-property vrange 'HorizontalAlignment)))
  ;; 内部値（例えば日付、金額は数値）
  (setq v (vlax-variant-value (vlax-get-property vrange 'Value2)))
  (cond 
    ((= hAlign -4108)(setq res 2))
    ((= hAlign -4152)(setq res 3))
    ((= hAlign -4131)(setq res 1))
    ;; 表示位置が設定されていないとき、数字は右、文字列は左基点にする
    ((and (= hAlign 1) (not (numberp v))) (setq res 1))
    ((and (= hAlign 1) (numberp v)) (setq res 3))
  )
  res
)
(defun ifs_put_HorizontalAlignment(vrange code72 / hAligns)
  ;; xlSystem = 1, xlLeft = -4131 (&HFFFFEFDD), xlCenter = -4108 (&HFFFFEFF4),  xlRight = -4152 (&HFFFFEFC8)
  (setq hAligns (list -4131 -4108 -4152))
  (vlax-put-property vrange 'HorizontalAlignment (nth code72 hAligns))      
)

;; フォントサイズ（そのままの値）
;; ポイント単位　取得/設定が可能な Variant 値
;; 2024/09/06 修正
(defun ifs_get_FontSize( vrange / v)
  (setq v  (vlax-get-property (vlax-get-property vrange 'Font) 'Size))
  (if v 
    (vlax-variant-value v )
    11
  )
)

;; 罫線
;; 上、下、左、右、下り対角線、上り対角線のビットコードを返す
;; 対角線のみ使用
(defun ifs_get_Borders(vrange  / borders i idxlst item len linestyle res)
  ;; xlEdgeLeft = 7, xlEdgeTop = 8, xlEdgeBottom = 9, xlEdgeRight = 10
  ;; 下り対角線 xlDiagonalDown = 5, 上り対角線 xlDiagonalUp = 6
  ;; xlNone = -4142 (&HFFFFEFD2)
  (setq res 0)
  (setq borders (vlax-get-property vrange 'Borders))
  ;; 上下、左右、対角線を取得
  ;;(setq idxlst (list 8 9 7 10 5 6) len (length idxlst) i 0)
  ;; 対角線のみ取得
  (setq idxlst (list 5 6) len (length idxlst) i 0)
  (repeat len
    (setq 
      item (vlax-get-property borders 'Item (nth i idxlst))
      linestyle  (vlax-variant-value (vlax-get-property item 'LineStyle))
    )
    (if (/= linestyle -4142)
      (setq res (+ res (lsh 1 i)))
    )
    (setq i (1+ i))
  )
  res
)
;; 結合されているか
;; 結合されているセルは、左、上の座標が結合エリアの左、上と同じ
(defun ifs_get_MergeArea(vrange /
                         mergeCells mergeArea mergeLeft mergeTop mergeColsCount mergeRowsCount res)
  (setq 
    mergeCells (vlax-variant-value (vlax-get-property vrange 'MergeCells))
    mergeArea (vlax-get-property vrange 'MergeArea)
    mergeRowsCount (vlax-get-property (vlax-get-property mergeArea 'Rows) 'Count)
    mergeColsCount (vlax-get-property (vlax-get-property mergeArea 'Columns) 'Count)
    mergeLeft (fix (vlax-variant-value (vlax-get-property mergeArea 'Left)))
    mergeTop  (fix (vlax-variant-value (vlax-get-property mergeArea 'Top )))
  )
  (if (= mergeCells :VLAX-TRUE)
    (setq res (list mergeRowsCount mergeColsCount mergeLeft mergeTop))
  )
  res
)
;; アクティブなセルの Row, Colをリストで返す
(defun ifs_get_ActiveCellRowCol( app / activeCell)
  (setq activeCell (vlax-get-property app 'ActiveCell))
  (list
    (vlax-get-property activeCell 'Row)
    (vlax-get-property activeCell 'Column)
  )
)
;; アクティブなセルのアドレスを "R1C1" 形式で返す
(defun ifs_get_ActiveCellAddress( app / activeCell)
  (setq activeCell (vlax-get-property app 'ActiveCell))
  (vlax-get-property activeCell 'Address nil nil -4150)
)
;; 計算式が設定されいるか
(defun ifs_get_vrangeHasFormula(vrange)
  (= :vlax-true (vlax-variant-value (vlax-get-property vrange 'HasFormula)))
)
;; 文字列分離
;; delim は１文字限定
(defun ifs_strSplit (str delim / ptr lst) 
  (while (setq ptr (vl-string-search delim str)) 
    (setq 
      lst (cons (substr str 1 ptr) lst)
      str (substr str (+ ptr 2))
    )
  )
  (reverse (cons str lst))
)
;; vle-string-replace と同じ
;; 存在するすべての oldStr が newStr に置換される
(defun ifs_string_replace ( newStr oldStr inStr / lastStr )
  (while (/= lastStr inStr)
    (setq lastStr inStr)
    (setq inStr (vl-string-subst newStr oldStr inStr))
  )
  inStr
)
;; vle-roundto 
(defun ifs_roundto ( x digits / )
  (atof (rtos x 2 digits))
)
;; 4 点が同じ直線上にあるか
(defun ifs_isDouitsu (p1 p2 p3 p4 / fuz res kaku p1 p2 p3 p4 lg1 lg2) 
  (setq 
    fuz 0.000001
    kaku (angle p1 p2)
    lg1  (* (distance p1 p3) (sin (- kaku (angle p1 p3))))
  )
  (if (equal 0 lg1 fuz) 
    (setq 
      lg2 (* (distance p1 p4) (sin (- kaku (angle p1 p4))))
      res (equal 0 lg2 fuz)
    )
  )
  res
)
;; POINTリストのうち距離が最大な２点を得る
;; 2点のときはそのまま返す
(defun ifs_maxDist2p(plist / cnt i j posa posb dist) 
  (setq 
    cnt  (length plist)
    i 0 dist 0.0
  )
  (if (> cnt 2) 
    (repeat cnt 
      (setq j (+ i 1))
      (repeat (- cnt i 1) 
        (if (> (distance (nth i plist) (nth j plist)) dist) 
          (setq dist (distance (nth i plist) (nth j plist))
                posa (nth i plist) posb (nth j plist)
          )
        )
        (setq j (1+ j))
      )
      (setq i (1+ i))
    )
    (setq posa (car plist) posb (cadr plist))
  )
  (if (and posa posb) 
    (list posa posb)
    nil
  )
)
;; 線分の表組を取得し、起動中の Excel に転送
(defun c:cadToExcel()
  (ifs_do_cadToExcel nil)
  (princ)
)
;; 線分の表組を取得し、ClipBoard にコピー
(defun c:cadToClipBrd()
  (ifs_do_cadToExcel T)
  (princ)
)
(defun ifs_do_cadToExcel(clipFlag / bottom colcount ename ent excelApp i j left leftcol lst 
     rc right rowcount s ss str top toprow worksheet xlsRun 
     xlst ylst clipFlag code72 dimsc kw txsc txtH vrange xsc ysc px w)
  
  (defun my_error(msg)
    (princ msg)
    (if (not clipFlag)
      (ifs_free_excelApp excelApp worksheet)
    )
    (setq *error* nil)
    (princ)
  )
  (setq *error* my_error) 
  
  ;; 設定 -----------------------------------
  (setq 
    xsc (/ 6.0 13.5)     ;; セルの線、罫線の X 方向の尺度 
    ysc (/ 6.0 13.5)     ;; セルの線、罫線の Y 方向の尺度 
    txsc (/ 2.5 11.0)     ;; 文字高さの尺度（Excel ｍ文字サイズ 11 のとき CAD 上の 2.5 mm になる）
    ;;txofsc 0.75 ;; 左、右基点のオフセット（文字高さ＊0.75 の余白）
  )
  (setq 
    dimsc (getvar "DIMSCALE")
    xsc (* xsc dimsc)
    ysc (* ysc dimsc)
    txsc (* txsc dimsc)
  )
  
  (if (and (not clipFlag)(setq excelApp (ifs_get_excelApp)))
    (if (setq worksheet (ifs_get_workSheet excelApp))
      (progn
        (setq 
          rc (ifs_get_ActiveCellRowCol excelApp)
          toprow (car rc) leftcol (cadr rc)
          xlsRun T
        )
        (initget "Yes No")
        (setq kw (getkword (strcat "\nアクティブセルは " (idx_toRangeStr toprow leftcol) " です. 処理を続けますか？ [Y/N] < Y > : " )))
        (setq xlsRun (/= kw "No"))
      )
    )
  )
  (if (setq lst (ifs_do_getGridXY (* 0.5 dimsc)))
    (progn
      (setq 
        xlst (car lst) ylst (cadr lst)
        str ""
      )
      (if (not clipFlag)
        (princ "\n転送中 ")
        (princ "\n取得中 ")
      )
      (acet-ui-progress-init "Excelへデータを転送中" (1- (length ylst)))

			(setq i 0)
			(repeat (setq rowcount (1- (length ylst)))
				(setq top (nth i ylst) bottom (nth (1+ i) ylst))
				(setq j 0)
				(repeat (setq colcount (1- (length xlst)))
					(setq left  (nth j xlst) right (nth (1+ j) xlst))
					(setq s "")
					(if (setq ss (ssget "W" (list left  top)(list right bottom) '((0 . "TEXT"))))
						(progn
							;; とりあえず最初の１個
							(setq 
                ename (ssname ss 0) ent (entget ename) s (cdr (assoc 1 ent))
                code72 (cdr (assoc 72 ent)) ;; code72 左から 0, 1, 2
                txtH (cdr (assoc 40 ent));; 文字高さ
              )
						)
					)
          (if xlsRun
            (progn
              (setq vrange (vlax-get-property worksheet 'Range (idx_toRangeStr (+ toprow i) (+ leftcol j))))
              (if (= :vlax-false (vlax-variant-value (vlax-get-property vrange 'HasFormula)))
                (progn
                  (ifs_put_vrangeValue vrange s)
                  (ifs_put_HorizontalAlignment vrange code72)
                )
              )
              ;; 行高さ
              (if (= j 0)
                ;; ポイント単位で指定
                ;; 小数点以下を丸める
                (vlax-put-property vrange 'RowHeight (ifs_roundto (/ (- top bottom) ysc) 3))
              )
              ;; 列幅
              (if (= i 0)
                (progn
                  ;; 取得している Width は ピクセル数 * 0.75（正しいかどうかは不明）
                  ;; ピクセル数から幅へは (ピクセル数 - 0.5) / 8
                  (setq px (fix (/ (/ (- right left) xsc) 0.75)));;ピクセル数
                  (setq w (/ (- px 5) 8.0));; ColWidth
                  (vlax-put-property vrange 'ColumnWidth (ifs_roundto w 3))
                )
              )
              ;; フォントサイズ       
              (vlax-put-property (vlax-get-property vrange 'Font) 'Size (fix (/ txtH txsc)))
            )
          )
          (if clipFlag
            (progn
              ; ClipBoard 用 TEXT
              (setq str (strcat str s))
              (if (<  j (1- colcount))
              	(setq str (strcat str "\t"))
              	(if (< i (1- rowcount));;最後に CrLf が必要かどうか
              		(setq str (strcat str "\r\n"))
              	)   
              )
            )
            
          )
					(setq j (1+ j))
				)
				(setq i (1+ i))
        (acet-ui-progress i)
        (princ ".")
     
			)
      (acet-ui-progress)
      (if (not clipFlag)(princ "\n終了しました．"))
    )
  )
  (if (and clipFlag (/= str ""))
    (progn
      (ifs_clearClipBoardText)
      (ifs_setClipBoardText str)
      (if (/= (ifs_getClipBoardText) "")
        (princ "\nクリップボードにコピーしました．")
      )
    )
  )
  (if (not clipFlag)
    (ifs_free_excelApp excelApp worksheet)
  )
  (princ)
)
;; *LINE で作成した表の格子を取得する
(defun ifs_do_getGridXY( fuz / plst fuz i ss temp 
				xlst ylst )
	(if (setq ss (ssget '((0 . "*LINE"))))
		(progn
			(setq i 0)
			(repeat (sslength ss)
	      (setq plst (append plst (acet-geom-object-point-list (ssname ss i) nil)))
				(setq i (1+ i))
			)
			(setq 
        ss nil
        xlst (mapcar 'car plst) ylst (mapcar 'cadr plst)
      )
		)
	)
	;;  格子の X, Y 座標リストを整理
	(if (and xlst ylst)
		(progn
			(setq 
        xlst (vl-sort xlst '<) ylst (vl-sort ylst '>)
			  temp (list (car xlst)) i 0
      )
			(repeat (1- (length xlst))
				(if (not (equal (nth i xlst)(nth (1+ i) xlst) fuz))
					(setq temp (append temp (list (nth (1+ i) xlst))))
				)
				(setq i (1+ i))
			)
			(setq xlst temp temp (list (car ylst)) i 0)
			(repeat (1- (length ylst))
				(if (not (equal (nth i ylst)(nth (1+ i) ylst) fuz))
					(setq temp  (append temp (list (nth (1+ i) ylst))))
				)
				(setq i (1+ i))
			)
			(setq ylst temp temp nil)
			(list xlst ylst)
		)
	)
)
;; CAD の exe 名
(defun ifs_exeName( / product res)
  (setq product (strcase (getvar "PRODUCT")))
  (cond 
    ((= product "AUTOCAD" )(setq res "acad.exe"))
    ((= product "BRICSCAD")(setq res "bricscad.exe"))
    ((= product "IJCAD"   )(setq res "gcad.exe"))
    ((= product "ZWCAD"   )(setq res "zwcad.exe"))
    (T (setq res ""))
  )
  res
)
;; CAD のフォルダ名（最後に"\\"は付かない)
(defun ifs_exePath()
  (vl-filename-directory (findfile (ifs_exeName)))
)
;; -----------------------------------------------------------------------------
;; クリップボード関数
;; 参照 :	 http://www.theswamp.org/index.php?topic=21764.0
;; -----------------------------------------------------------------------------
(defun ifs_setClipBoardText (text / htmlfile result) 
  ;;	Caller's sole responsibility is to pass a
  ;;	text string. Anything else? Pie in face.
  ;;	Attribution: Reformatted version of 
  ;;	post by XShrimp at theswamp.org.
  ;;
  ;;	See http://tinyurl.com/2ngf4r.
  (setq result (vlax-invoke 
                 (vlax-get 
                   (vlax-get 
                     (setq htmlfile (vlax-create-object "htmlfile"))
                     'ParentWindow
                   )
                   'ClipBoardData
                 )
                 'SetData
                 "Text"
                 text
               )
  )
  (vlax-release-object htmlfile)
  text
)
;; クリップボード関数
(defun ifs_getClipBoardText (/ htmlfile result) 
  ;;	Attribution: Reformatted version of
  ;;	post by Patrick_35 at theswamp.org.
  ;;
  ;;	See http://tinyurl.com/2ngf4r.
  (setq result (vlax-invoke 
                 (vlax-get 
                   (vlax-get 
                     (setq htmlfile (vlax-create-object "htmlfile"))
                     'ParentWindow
                   )
                   'ClipBoardData
                 )
                 'GetData
                 "Text"
               )
  )
  (vlax-release-object htmlfile)
  result
)
;; -----------------------------------------------------------------------------
;; クリップボード関数
(defun ifs_clearClipBoardText (/ htmlfile result) 
  (setq result (vlax-invoke 
                 (vlax-get 
                   (vlax-get 
                     (setq htmlfile (vlax-create-object "htmlfile"))
                     'ParentWindow
                   )
                   'ClipBoardData
                 )
                 'ClearData
                 "Text"
               )
  )
  (vlax-release-object htmlfile)
  result
)
;; ------------------------------------------

(princ "\nexcelToCAD2 2024.09.07 ロードしました．")
(princ "\nexcelToCad, excelToCadEx, excelToCadApp, excelToCadAppEx, cadToExcel, cadToClipBrd が使えます.．")

(princ)

