;;;-------------------<宿題５>--------------------------------------
;;;
;;;   線分を複数指示して、その長さの合計を表示するコマンド
;;;
;;;  2001.06.05                                  Programed by mapcar
;;;-----------------------------------------------------------------
;;楽しみ方：
;;  今回はちょっと忙しかったので、やりたいことのコンセプトだけで、
;;  細かい作り込みは省略しました。
;;      (Step1) コマンド発行 (c:linlen)
;;      (Step2) LINE をピック(LINE以外は未対応)。
;;              画面上でピックしたLINE総数と合計長さが表示されます。
;;      (Step3) ２回目の図形ピックミスでブロック図形 linlen をその
;;              位置にインサートします。
;;------------------------------------------------------------------
(defun c:linlen ; 線分を複数指示して、その長さの合計を表示する 2001.06.05
  (
  /
    nn len loop en0 ua ub scale en1 ety 
    pc p0 p1 p2 p3 ss miss ii en2 ety2 
  )
    (setq nn 0)
    (setq len 0.0)
    (setq loop T)
    (mk_icon nn len)
    (while loop
        (setq en0 (entlast))
        (setq ua (c_p2u 4))
        (setq ub (- ua))
        (setq scale (* 2.0 ua))
        (command "insert" "linlen" "x" scale "y" scale "r" 0.0 pause)
        (setq en1 (entlast))
        (if (/= en0 en1) (progn
            (setq ety (entget en1))
            (setq pc (trans (cdr (assoc 10 ety)) en1 2))
            (setq p0 (mapcar '+ pc (list ub ub)))
            (setq p1 (mapcar '+ pc (list ua ub)))
            (setq p2 (mapcar '+ pc (list ua ua)))
            (setq p3 (mapcar '+ pc (list ub ua)))
            (if (setq ss (ssget "CP" (list p0 p1 p2 p3)))
                (if (= (sslength ss) 1)
                    (progn ; ２回目の失敗で終了固定
                        (setq miss (1+ miss))
                        (if (> miss 1)
                            (setq loop nil)
                            (entdel en1)
                        )
                    )
                    (progn
                        (repeat (setq ii (sslength ss))
                            (setq en2 (ssname ss (setq ii (1- ii))))
                            (setq ety2 (entget en2))
                            (if (= (cdr (assoc 0 ety2)) "LINE") (progn
                                (setq miss 0)
                                (redraw en2 3)
                                (setq nn (1+ nn))
                                (setq p0 (cdr (assoc 10 ety2)))
                                (setq len (+ len (distance (cdr (assoc 10 ety2)) (cdr (assoc 11 ety2)))))
                            ))
                        )
                        (entdel en1)
                    )
                )
            )
        ))
        (mk_icon nn len)
    )
)

(defun mk_icon ( nn len / ety ) ; 2001.06.05 Create
    (entmake '((0 . "BLOCK") (2 . "linlen") (70 . 0) (10 0.0 0.0 0.0)))
    (entmake '((0 . "LINE") (8 . "0") (10 -0.5 -0.5 0.0) (11  0.5 -0.5 0.0) (210 0.0 0.0 1.0)))
    (entmake '((0 . "LINE") (8 . "0") (10  0.5 -0.5 0.0) (11  0.5  0.5 0.0) (210 0.0 0.0 1.0)))
    (entmake '((0 . "LINE") (8 . "0") (10  0.5  0.5 0.0) (11 -0.5  0.5 0.0) (210 0.0 0.0 1.0)))
    (entmake '((0 . "LINE") (8 . "0") (10 -0.5  0.5 0.0) (11 -0.5 -0.5 0.0) (210 0.0 0.0 1.0)))
    (setq ety '((0 . "TEXT") (8 . "0") (10 1.0 -3.0 0.0) (40 . 2.0) (1 . "")  (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "STANDARD") (71 . 0) (72 . 0) (11 0.0 0.0 0.0) (210 0.0 0.0 1.0) (73 . 0)))
    (setq ety (subst (cons 1 (strcat "Total lines = " (itoa nn))) (assoc 1 ety) ety))
    (entmake ety)
    (setq ety '((0 . "TEXT") (8 . "0") (10 1.0 -6.0 0.0) (40 . 2.0) (1 . "") (50 . 0.0) (41 . 1.0) (51 . 0.0) (7 . "STANDARD") (71 . 0) (72 . 0) (11 0.0 0.0 0.0) (210 0.0 0.0 1.0) (73 . 0)))
    (setq ety (subst (cons 1 (strcat "Total length = " (rtos len))) (assoc 1 ety) ety))
    (entmake ety)
    (entmake '((0 . "ENDBLK")))
)

(defun c_p2u ; ピクセルを長さに変換する 1995/09/29 create
        (
            pixel ; <int> ピクセル数
        )
    (* pixel (/ (* 1.0 (getvar "VIEWSIZE"))
                (* 1.0 (cadr (getvar "SCREENSIZE")))))
)

(princ "\nコマンド名は linlen です。")
(princ)