(defun c:ufc00001 ( / eps ss nn ente enls
                      pp1 pp2 pp3 pp4 ve1 ve2 ve3
                      xw1 xw2 xx1 yy1 xx2 yy2 zz1 zz2 len pw1 pw2 )
;中間線分作図
;選択された２線分の中間に線分を作図する
  (setq eps 0.001)
  (prompt "\n２線分を選択：")
  (setq ss (ssget '((0 . "LINE")) )) ;線分を選択
  (setq nn 0)
  (if (/= ss nil)
    (setq nn (sslength ss))
  )
  (if (/= nn 2)
    (prompt "\n２線分を選択して下さい。")
    (progn
      (setq ente (ssname ss 0))
      (setq enls (entget ente))
      (setq pp1 (cdr (assoc 10 enls)))
      (setq pp2 (cdr (assoc 11 enls)))
      (setq ente (ssname ss 1))
      (setq enls (entget ente))
      (setq pp3 (cdr (assoc 10 enls)))
      (setq pp4 (cdr (assoc 11 enls)))
      (setq ve1 (ufb00001 pp1 pp2 eps))
      (setq ve2 (ufb00001 pp3 pp4 eps))
      (setq ve3 (ufb00001 pp4 pp3 eps))
      (if (or (= ve1 nil) (= ve2 nil))
        (prompt "\n選択された線分のうちどちらかが短か過ぎます。")
        (progn
          (setq xw1 (+ (* (car ve1) (car ve2)) (* (cadr  ve1) (cadr  ve2))
                                               (* (caddr ve1) (caddr ve2))))
          (setq xw2 (+ (* (car ve1) (car ve3)) (* (cadr  ve1) (cadr  ve3))
                                               (* (caddr ve1) (caddr ve3))))
          (if (> xw1 xw2) ;内積が正の場合は同一方向
            (progn
              ;pp1とpp3のpp2とpp4中間点を求める
              (setq xx1 (/ (+ (car   pp1) (car   pp3)) 2.0))
              (setq yy1 (/ (+ (cadr  pp1) (cadr  pp3)) 2.0))
              (setq xx2 (/ (+ (car   pp2) (car   pp4)) 2.0))
              (setq yy2 (/ (+ (cadr  pp2) (cadr  pp4)) 2.0))
              (setq zz1 0.0)
              (setq zz2 0.0)
              (setq pw1 (list xx1 yy1 zz1))
              (setq pw2 (list xx2 yy2 zz2))
              (setq len (distance pw1 pw2))
              (if (<= len eps)
                (prompt "\n作図する中間線分は短か過ぎます。")
                (command "line" "none" pw1 "none" pw2 "")
              )
            )
            (progn
              ;pp1とpp4のpp2とpp3中間点を求める
              (setq xx1 (/ (+ (car  pp1) (car  pp4)) 2.0))
              (setq yy1 (/ (+ (cadr pp1) (cadr pp4)) 2.0))
              (setq xx2 (/ (+ (car  pp2) (car  pp3)) 2.0))
              (setq yy2 (/ (+ (cadr pp2) (cadr pp3)) 2.0))
              (setq zz1 0.0)
              (setq zz2 0.0)
              (setq pw1 (list xx1 yy1 zz1))
              (setq pw2 (list xx2 yy2 zz2))
              (setq len (distance pw1 pw2))
              (if (<= len eps)
                (prompt "\n作図する中間線分は短か過ぎます。")
                (command "line" "none" pw1 "none" pw2 "")
              )
            )
          )
        )
      )
    )
  )
  (princ)
)
(defun ufb00001 ( u_p1  ;線分の始点
                  u_p2  ;線分の終点
                  u_eps ;許容誤差
                / vv    ;単位ベクトル（２次元）　Ｚ成分は０．０
                        ; nil:単位ベクトルが算出できないとき
                        ;     始点と終点が同一点（Ｚ＝０平面）
                  xx yy ll vx vy zv )
;単位ベクトルを求める（２次元）
  (setq vv nil)
  (setq xx (- (car  u_p2) (car  u_p1)))
  (setq yy (- (cadr u_p2) (cadr u_p1)))
  (setq ll (sqrt (+ (* xx xx) (* yy yy))))
  (if (> ll u_eps)
    (progn
      (setq vx (/ (- (car  u_p2) (car  u_p1)) ll))
      (setq vy (/ (- (cadr u_p2) (cadr u_p1)) ll))
      (setq vz 0.0)
      (setq vv (list vx vy vz))
    )
  )
  vv
)