;AUTOCAD R14 c2pw.LSP
;色別線と寸法図形を分解して太さ指定のポリラインに編集してwmfに書き出し。
;午後 05:13 00/05/29
;Atsuhiro Kawasaki
;

(DEFUN C:C2PW ( / a f inilist poplist ilist verf ech colorlist)
;;;各種設定の初期化
 (SETQ
  poplist (LIST "0.0" "0.05" "0.1" "0.15" "0.2" "0.25" "0.3" "0.4" "0.5" "0.6" "0.8" "1.0" "1.2" "1.7" "2.0" "2.5" "3.0" "4.0" "5.0")
  inilist (LIST "2" "2" "2" "2" "2" "2" "2" "2" "2" "2")
  verf (SUBSTR (GETVAR "ACADVER") 1 2)
  ech (GETVAR "CMDECHO")
 );en-sq
 (ftmp "c2pw.dcl")
 (IF (FINDFILE f) (princ "\n/find dcl ok") (MKDCL f))        ;dclの存在確認 なければ生成
 (ftmp "init.c2p")
 (IF (FINDFILE f) (princ "\n/find init ok") (opw))           ;initの存在確認 なければ生成
 (loadini)(IF f (opr) (rfle))                                  ;設定選択 canselなら前回設定
 (ftmp "c2pw.dcl")(ccdb f)                                     ;ダイアログ表示 線幅編集
 (IF (= a 1)
  (PROGN
  (wfle)                ;現在設定書込
  (saveini)             ;設定別名登録 canselならしない
;;;メイン処理開始
  (lyli)                ;画層色リスト作成((画層名.色番号)..)
  (SETVAR "CMDECHO" 0)
  (COMMAND "UNDO" "G")
  (exenti 3)           ;ブロックの完全分解
  (COMMAND "PURGE" "B" "*" "N")
  (cira)               ;円を円弧に変換
  (exenti 4)           ;ポリラインの完全分解
  (lcex)               ;画層色を色に
  (scli)               ;類似色リスト作成((類似色.基本色)..)
  (scex)               ;類似色を基本色に変換してPEDIT実行
  (d2pw)               ;寸法線と引出線処理
  (bgcw)               ;背景処理
  (insb "*_etcb_")
  (COMMAND "REGENALL")
;;;書き出し処理開始
  (fnam ".wmf")
  (SETVAR "FILEDIA" 0)
  (COMMAND "_EXPORT" F "ALL" "")
  (COMMAND "UNDO" "E")(COMMAND "U")
  (SETVAR "CMDECHO" ech)
  (SETVAR "FILEDIA" 1)
  (PRINC "\n/\nＷＭＦで書き出しました。ファイル名は[")(PRINC F)(PRINC "]です。")
 ));en-pg-if
 (PRINC)
);en-fn

(DEFUN d2pw ( / s dimw leaw da job)
  (SETQ job 3
        dimw (ATOF (NTH (ATOI (NTH 8 inilist)) poplist))
        leaw (ATOF (NTH (ATOI (NTH 9 inilist)) poplist)))
  (scs "a" '(0 "DIMENSION"))
  (IF s
   (ablo "_dimb_" s)
   (SETQ dimw 0 job (1- job))
  );en-if
  (scs "OR" '(0 "LEADER" 0 "MTEXT"))
  (IF s
   (ablo "_leab_" s)
   (SETQ leaw 0 job (- job 2))
  );en-if
  (scs "a" '()) 
  (ablo "_etcb_" s)
  (IF (> job 0)
   (PROGN
    (IF (> dimw 0.0)
     (PROGN
      (insb "*_dimb_")
      (ex 1 0)
      (ex 3 0)
      (ex 5 dimw)
      (scs "a" '())
      (bblo "_dimb_" S)
    ));en-pg-if
    (IF (> leaw 0.0)
     (PROGN
      (insb "*_leab_")
      (ex 2 0)
      (ex 3 0)
      (ex 4 0)
      (ex 5 leaw)
      (scs "a" '())
      (bblo "_leab_" S)
    ));en-pg-if
  ));en-pg-if
 (IF (OR (= job 3) (= job 1)) (insb "*_dimb_"))
 (IF (> job 1) (insb "*_leab_"))
 (insb "*_etcb_")
 (COMMAND "CHANGE" "ALL" "" "P" "C" 18 "")
 (scs "a" '())
 (bblo "_etcb_" S)
);en-fn

(DEFUN lyli ( / da)
(SETQ da 0)
 (WHILE da
  (IF colorlist (SETQ da (TBLNEXT "layer")) (SETQ da (TBLNEXT "layer" T)))
  (IF da
   (IF colorlist
    (SETQ colorlist (CONS (CONS (CDR (ASSOC '2 da)) (CDR (ASSOC '62 da))) colorlist))
    (SETQ colorlist (LIST (CONS (CDR (ASSOC '2 da)) (CDR (ASSOC '62 da)))))
))));en-if-if-wl-fn

(DEFUN scli ()
 (SETQ colorlist
  (LIST
   (CONS 1 1) (CONS 10 1) (CONS 20 1) (CONS 30 1) (CONS 240 1)
   (CONS 2 2) (CONS 40 2) (CONS 50 2)
   (CONS 3 3) (CONS 60 3) (CONS 70 3) (CONS 80 3) (CONS 90 3) (CONS 100 3) (CONS 110 3)
   (CONS 4 4) (CONS 120 4) (CONS 130 4) (CONS 140 4)
   (CONS 5 5) (CONS 150 5) (CONS 160 5) (CONS 170 5) (CONS 180 5)
   (CONS 6 6) (CONS 190 6) (CONS 200 6) (CONS 210 6) (CONS 220 6) (CONS 230 6)
   (CONS 7 7) (CONS 255 7)
)));en-fn

(DEFUN cira ( / s i elist)
 (scs "A" '(0 "CIRCLE"))
 (IF S
  (PROGN
   (SETQ I 0)
    (WHILE (<= I (1- (SSLENGTH S)))
     (SETQ elist (ENTGET (SSNAME S I)))
     (c2arc 0.0 pi)
     (c2arc pi 0.0)
     (entdel (SSNAME S I))
     (SETQ I (1+ I))
))));en-fn

(DEFUN lcex ( / s i ed elist)
 (scs "OR" '(0 "LINE" 0 "ARC"))
 (IF S
  (PROGN
   (SETQ I 0)
    (WHILE (<= I (1- (SSLENGTH S)))
     (SETQ elist (ENTGET (SSNAME S I)))
      (IF (= nil (ASSOC '62 elist))
       (PROGN
        (SETQ ed (CONS (CONS 62 (CDR (ASSOC (CDR (ASSOC '8 elist)) colorlist))) elist))
        (ENTMOD ed)
      ));en-pg-if
     (SETQ I (1+ I))
))));en-fn

(DEFUN scex ( / s i ea ed elist)
 (scs "OR" '(0 "LINE" 0 "ARC"))
 (IF S
  (PROGN
   (SETQ I 0)
    (WHILE (<= I (1- (SSLENGTH S)))
     (SETQ
      elist (ENTGET (SSNAME S I))
      ed (ASSOC '62 elist)
      ea (ASSOC (CDR ed) colorlist)
     );en-sq
    (IF (= (CAR ea) (CDR ed)) (SETQ ea (CDR ea)) (SETQ ea 8))
    (SETQ ed (SUBST (CONS 62 18) ed elist) )
    (ENTMOD ed)
    (SETQ ed (ATOF (NTH (ATOI (NTH (1- ea) inilist)) poplist)))
    (COMMAND "_PEDIT" (SSNAME S I) "Y" "W" (* ed (getvar "dimscale")) "X" )
    (SETQ I (1+ I))
))));en-fn

(DEFUN c2arc (ang1 ang2 / )
 (IF (assoc 62 elist)
  (ENTMAKE 
   (LIST
    '(0 . "ARC")
    '(100 . "AcDbEntity") 
     (cons 67 (cdr (assoc '67 elist)))
     (cons 8 (cdr (assoc '8 elist)))
     (cons 62 (cdr (assoc '62 elist)))
    '(100 . "AcDbCircle")
     (cons 10 (cdr (assoc '10 elist)))
     (cons 40 (cdr (assoc '40 elist)))
     (cons 210 (cdr (assoc '210 elist)))
    '(100 . "AcDbArc")
     (cons 50 ang1)
     (cons 51 ang2)
  ));en-em
  (ENTMAKE 
   (LIST
    '(0 . "ARC")
    '(100 . "AcDbEntity") 
     (cons 67 (cdr (assoc '67 elist)))
     (cons 8 (cdr (assoc '8 elist)))
    '(100 . "AcDbCircle")
     (cons 10 (cdr (assoc '10 elist)))
     (cons 40 (cdr (assoc '40 elist)))
     (cons 210 (cdr (assoc '210 elist)))
    '(100 . "AcDbArc")
     (cons 50 ang1)
     (cons 51 ang2)
  ));en-em 
));en-fn

;図形の完全分解
(DEFUN exenti ( e / s i)
 (SETQ S 1)
 (WHILE S
  (COND
   ((= E 3) (scs "A" '(0 "INSERT")))
   ((= E 4) (scs "A" '(0 "LWPOLYLINE")))
   (t nil)
  );en-co
  (IF S
   (PROGN
    (SETQ I 0)
     (WHILE (<= I (1- (SSLENGTH S)))
      (COMMAND "EXPLODE" (SSNAME S I) )
      (SETQ I (1+ I))
)))));en-fn

(DEFUN ablo ( AN AS / )
 (IF (= verf "15")
  (COMMAND "-BLOCK" AN "0,0,0" AS "")
  (COMMAND "_BLOCK" AN "0,0,0" AS "")
));en-if-fn

(DEFUN bblo ( AN AS / )
 (IF (= verf "15")
  (COMMAND "-BLOCK" AN "Y" "0,0,0" AS "")
  (COMMAND "_BLOCK" AN "Y" "0,0,0" AS "")
));en-if-fn

(DEFUN insb ( AN / )
 (IF (= verf "15")
  (COMMAND "-INSERT" AN "0,0,0" "1" "0")
  (COMMAND "_INSERT" AN "0,0,0" "1" "0")
));en-if-fn

(DEFUN ex ( E W / S I)
 (COND
  ((= E 1) (scs "A" '(0 "DIMENSION")))
  ((= E 2) (scs "A" '(0 "LEADER")))
  ((= E 3) (scs "A" '(0 "INSERT")))
  ((= E 4) (scs "A" '(0 "LWPOLYLINE")))
  ((= E 5) (scs "OR" '(0 "LINE" 0 "ARC")))
  (t nil)
 );en-co
 (IF S
  (PROGN
   (SETQ I 0)
    (WHILE (<= I (1- (SSLENGTH S)))
     (IF (= E 5)
      (COMMAND "_PEDIT" (SSNAME S I) "Y" "W" (* W (getvar "dimscale")) "X" )
      (COMMAND "_EXPLODE" (SSNAME S I) )
     );en-if
     (SETQ I (1+ I))
))));en-fn

(DEFUN scs ( GE GL / NE FL SI)
 (IF (> (LENGTH GL) 2)
  (SETQ FL (LIST (CONS -4 (STRCAT GE ">"))))
 );en-if
 (SETQ SI 0)
  (WHILE (< SI (LENGTH GL))
   (SETQ NE (CONS (NTH SI GL) (NTH (1+ SI) GL)))
    (IF FL
     (SETQ FL (CONS NE FL))
     (SETQ FL (LIST NE))
    );en-if
   (SETQ SI (+ 2 SI))
  );en-wl
 (IF (> (LENGTH GL) 2)
  (SETQ FL (CONS (CONS -4 (STRCAT "<" GE)) FL))
 );en-if
 (IF (= (LENGTH GL) 0)
  (SETQ S (SSGET "C" (GETVAR "VSMAX") (GETVAR "VSMIN")))
  (SETQ S (SSGET "C" (GETVAR "VSMAX") (GETVAR "VSMIN") FL))
 );en-if
);en-fn

(DEFUN ccdb (dclname / dcl_id  keylist k0 k1 k2 k3 k4 k5 k6 k7 k8 k9)
 (SETQ
  keylist (LIST "k_0" "k_1" "k_2" "k_3" "k_4" "k_5" "k_6" "k_7" "k_8" "k_9")
  k0 (NTH 0 inilist)
  k1 (NTH 1 inilist)
  k2 (NTH 2 inilist)
  k3 (NTH 3 inilist)
  k4 (NTH 4 inilist)
  k5 (NTH 5 inilist)
  k6 (NTH 6 inilist)
  k7 (NTH 7 inilist)
  k8 (NTH 8 inilist)
  k9 (NTH 9 inilist)
 );en-sq
 (SETQ dcl_id (load_dialog dclname))
 (IF (NOT (new_dialog "c2pw" dcl_id) ) (EXIT))
   (adli)
   (seti)
   (action_tile "accept" "(done_dialog 1)")
   (action_tile "cancel" "(done_dialog 0)")
   (action_tile "k_0" "(setq k0 (get_tile \"k_0\"))(ilmk)")
   (action_tile "k_1" "(setq k1 (get_tile \"k_1\"))(ilmk)")
   (action_tile "k_2" "(setq k2 (get_tile \"k_2\"))(ilmk)")
   (action_tile "k_3" "(setq k3 (get_tile \"k_3\"))(ilmk)")
   (action_tile "k_4" "(setq k4 (get_tile \"k_4\"))(ilmk)")
   (action_tile "k_5" "(setq k5 (get_tile \"k_5\"))(ilmk)")
   (action_tile "k_6" "(setq k6 (get_tile \"k_6\"))(ilmk)")
   (action_tile "k_7" "(setq k7 (get_tile \"k_7\"))(ilmk)")
   (action_tile "k_8" "(setq k8 (get_tile \"k_8\"))(ilmk)")
   (action_tile "k_9" "(setq k9 (get_tile \"k_9\"))(ilmk)")
 (SETQ a (start_dialog))
 (unload_dialog dcl_id)
);en-fn

(DEFUN ilmk ()
 (SETQ inilist (LIST k0 k1 k2 k3 k4 k5 k6 k7 k8 k9))
);en-fn

(DEFUN adli ( / keyname i)
 (SETQ i 0 )
 (WHILE (SETQ keyname (NTH i keylist))
   (start_list keyname)
    (MAPCAR 'add_list poplist)
   (end_list)
  (SETQ i (1+ i))
));en-wl-fn

(DEFUN seti ()
 (set_tile "k_0" k0)
 (set_tile "k_1" k1)
 (set_tile "k_2" k2)
 (set_tile "k_3" k3)
 (set_tile "k_4" k4)
 (set_tile "k_5" k5)
 (set_tile "k_6" k6)
 (set_tile "k_7" k7)
 (set_tile "k_8" k8)
 (set_tile "k_9" k9)
);en-fn

(DEFUN sett ( k d / )
 (set_tile k (NTH (ATOI d) poplist))
);en-fn

(DEFUN loadini ()
 (IF
  (SETQ f (GETFILED "設定ファイル選択。初期化-[init.c2p] 選択。 前回と同じ-[cancel]ボタン or [Esc]" (GETVAR "TEMPPREFIX") "c2p" 0))
  (opr)
 )
);en-fn

(DEFUN saveini ()
 (IF
  (SETQ f (GETFILED "現在設定を別名登録。しない-[cancel]ボタン or [Esc]  <この後メイン処理開始します。>" (GETVAR "TEMPPREFIX") "c2p" 3))
  (opw)
 )
);en-fn

(DEFUN rfle () (ftmp "ftmp.ccc")(opr));en-fn

(DEFUN wfle () (ftmp "ftmp.ccc")(opw));en-fn

(DEFUN opr ( / fa k0 k1 k2 k3 k4 k5 k6 k7 k8 k9)
 (IF (FINDFILE f) (princ) (ftmp "init.c2p"))
 (SETQ
  fa (OPEN f "r")
  k0 (READ-LINE fa)
  k1 (READ-LINE fa)
  k2 (READ-LINE fa)
  k3 (READ-LINE fa)
  k4 (READ-LINE fa)
  k5 (READ-LINE fa)
  k6 (READ-LINE fa)
  k7 (READ-LINE fa)
  k8 (READ-LINE fa)
  k9 (READ-LINE fa)
 );en-sq
 (CLOSE fa)
 (PRINC "\n")(PRINC f)(PRINC "\n")
 (PRINC "上記のファイルから読込みました。\n")
 (ilmk)
);en-fn

(DEFUN opw ( / fa i)
 (SETQ fa (OPEN f "w") i 0)
  (WHILE (< i 10)
   (WRITE-LINE (NTH i inilist) fa)
   (SETQ i (1+ i))
  );en-wl
 (CLOSE fa)
 (PRINC "\n")(PRINC F)(PRINC "\n")
 (PRINC "上記のファイルへ記録しました。\n")
);en-fn

(DEFUN ftmp ( fn / )
 (SETQ f (STRCAT (GETVAR "TEMPPREFIX") fn))
);en-fn

(DEFUN fnam ( EX / )
 (SETQ
  F (STRCAT (GETVAR "DWGPREFIX") (GETVAR "DWGNAME"))
  F (STRCAT (SUBSTR F 1 (- (STRLEN F) 4)) EX)
));en-sq-fn

(DEFUN MKDCL ( fn / MF )
 (SETQ MF (OPEN fn "w"))
 (write-line "c2pw:dialog{label=\"/線幅の変更/C9_projects\"\;" MF)
 (write-line "  :row{" MF)
 (write-line "   :boxed_column{" MF)
 (write-line "      :c_image{color=1\;}:c_image{color=2\;}:c_image{color=3\;}:c_image{color=4\;}" MF)
 (write-line "      :c_image{color=5\;}:c_image{color=6\;}:c_image{color=7\;}:c_image{color=8\;}" MF)
 (write-line "      :c_image{color=56\;}:c_image{color=76\;}" MF)
 (write-line "   }" MF)
 (write-line "   :boxed_column{" MF)
 (write-line "      :c_pop{label=\"赤色\"\;key=\"k_0\"\;}:c_pop{label=\"黄色\"\;key=\"k_1\"\;}:c_pop{label=\"緑色\"\;key=\"k_2\"\;}" MF)
 (write-line "      :c_pop{label=\"水色\"\;key=\"k_3\"\;}:c_pop{label=\"青色\"\;key=\"k_4\"\;}:c_pop{label=\"紫色\"\;key=\"k_5\"\;}" MF)
 (write-line "      :c_pop{label=\"白色\"\;key=\"k_6\"\;}:c_pop{label=\"灰他\"\;key=\"k_7\"\;}" MF)
 (write-line "      :c_pop{label=\"寸法\"\;key=\"k_8\"\;}:c_pop{label=\"引出\"\;key=\"k_9\"\;}" MF)
 (write-line "   }" MF)
 (write-line "  }" MF)
 (write-line " ok_cancel\;" MF)
 (write-line "}" MF)
 (write-line "c_image:image{width=5\;}" MF)
 (write-line "c_pop:popup_list{edit_width=10\;}" MF)
 (CLOSE MF)
);end fun

(DEFUN bgcw ( / vct vsi p1 p2)
 (SETQ vct (GETVAR "VIEWCTR"))
 (SETQ vsi (GETVAR "VIEWSIZE"))
 (SETQ p1 (list (- (car vct) (* vsi 3)) (cadr vct) -1))
 (SETQ p2 (list (+ (car vct) (* vsi 3)) (cadr vct) -1))
 (SETQ vsi (* 2 vsi))
 (COMMAND "PLINE" p1 "w" vsi vsi p2 "w" 0 0 "")
 (COMMAND "CHANGE" (entlast) "" "P" "C" 7 "")
);en-fn

(PRINC "\ncommand-name <C2PW> created by_C9_projects 00-05-29")
(PRINC "\nR14用LSPファイルをロード\nコマンド名は: Ｃ２ＰＷ です。")
(PRINC)