[弹指神通]：为感谢大家免币赠送画卫生间的超好LISP!

jeepsheep

为感谢大家免币赠送画卫生间的超好LISP!
现给大家看看完成后的图片。下面接着有源代码和教学。

jeepsheep

(defun c:toilet (/ v0 v1 v2 v3 v4 v5 v6 v7 v8 v9 v10 v11 v12 v13 v14 v15 v16 v17
                 pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 aper pick orth)
  (setvar "cmdecho" 0)
  (command ".undo" "g")
  (setq clay (getvar "clayer")
        sblip(getvar "blipmode")
        ccol (getvar "cecolor")
        orth (getvar "orthomode")
        pick (getvar "pickbox")
        aper (getvar "aperture"))
  (if (/= (substr ccol 1 1) "B") (setq ccol (atoi (substr ccol 1 2))))
  (if (null *th) (setq *th 100))
  (if (null *dp) (setq *dp 1500))
  (if (null *op) (setq *op 600))
  (graphscr)
  (setvar "coords" 1)
  (setvar "blipmode" 0)
  (setvar "aperture" 4)
  (initget 6)
  (setq v1 (getint "\nNo. of toilet 间隔间: <1> "))
  (if (not v1) (setq v1 1))
  (initget 7)
  (setq v0 (getdist "\n点出卫生间的总长: "))
  (initget 6)
  (setq v3 (getdist (strcat "\n内深: <" (rtos *dp 2 2) "> ")))
  (initget 6)
  (setq v4 (getdist (strcat "\n隔板厚度: <" (rtos *th 2 2) "> ")))
  (initget 6)
  (setq v5 (getdist (strcat "\n门宽: <" (rtos *op 2 2) "> ")))
  (if (null v3) (setq v3 *dp) (setq *dp v3))
  (if (null v4) (setq v4 *th) (setq *th v4))
  (if (null v5) (setq v5 *op) (setq *op v5))
  (initget "L R")
  (setq v7 (getkword "\n<L>左开/<R>右开门: "))
  (initget "Y N")
  (setq v8 (getkword "\nFirst wall required? <N> "))
  (initget "Y N")
  (setq v9 (getkword "\nLast wall required? <Y> "))
  (if (null v7) (setq v7 "R"))
  (if (null v8) (setq v8 "N"))
  (if (null v9) (setq v9 "Y"))
  (if (= v8 "N") (setq v8 0))
  (if (= v8 "Y") (setq v8 1))
  (if (= v9 "N") (setq v9 0))
  (if (= v9 "Y") (setq v9 1))
  (setq v2 (/ (- v0 (* v4 (+ v8 v9 (1- v1)))) v1)
        v6 (/ (- v2 v5) 2.0))
  (while (< v6 100)
    (princ (strcat "\nSpace on door side=  " (rtos v6 2 2) " < 100!"))
    (initget 6)
    (setq v5 (getdist (strcat "\nSmaller door width value: <"
      (rtos v5 2 2) "> ")))
    (initget 6)
    (setq v10 (getdist (strcat "\Larger overall distance: <"
      (rtos v0 2 2) "> ")))
    (if (null v5) (setq v5 *op))
    (if v10 (setq v0 v10))
    (setq v2 (/ (- v0 (* v4 (+ v8 v9 (1- v1)))) v1)
          v6 (/ (- v2 v5) 2.0))
  )
  (setq ent (entsel "\nPick start end of wall: "))
  (while (null ent)
    (setq ent (entsel "\n No object found!\nPick start end of wall: "))
  )
  (setq pt1 (osnap (cadr ent) "end")
        pt2 (osnap (cadr ent) "mid")
        v10 (* (distance pt1 pt2) 2.0)
        v11 (angle pt1 pt2)
        v12 (cdr (assoc 8 (entget (car ent))))
        v13 (cdr (assoc 62(entget (car ent)))))
  (setvar "orthomode" 0)
  (initget 1)
  (setq pt3 (getpoint pt1 "\nIndicate location of toilet: "))
    (if (= v8 1)
    (progn
     (initget 7)
     (setq v14 (getdist pt1 "\nOffset distance to toilet first wall: "))
     (setq pt1 (polar pt1 v11 v14)
           pt2 (polar pt1 v11 v0))
    )
    (setq pt2 (polar pt1 v11 v0))
  )
  (setvar "orthomode" orth)
  (if (and (= v0 v10) (> v4 75))
    (progn (setvar "aperture" 1) (command ".erase" (car ent) "")))
  (if (and (< v0 v10) (> v4 75))
    (progn (setvar "aperture" 1) (command ".break" (car ent) pt2 pt1)))
  (command ".layer" "s" v12 "")
  (command ".color" v13)
  (if (= (getvar "gridmode") 1) (progn (setq grid 1) (setvar "gridmode" 0)))
  (if (= (getvar "ucsicon") 1) (progn (setq icon 1) (setvar "ucsicon" 0)))
  (setq v16 (angle pt1 pt2) v17 (angle pt1 pt3))
  (command ".ucs" "3" pt1 pt2 pt3)
  (if (= v8 0)
    (progn
     (setq pt0 '(0 0)
           pt1 (list (car pt0) v3)
           pt3 (list (+ (car pt1) v6) (+ (cadr pt1) v4))
           pt2 (list (car pt3) (cadr pt1))
           pt4 (list (car pt1) (cadr pt3))
           pt9 pt2)
     (command ".pline" pt1 "w" 0 0 pt2 pt3 pt4 "") (setq v10 (entlast))
     (if (and (> v4 75) (null v14))
       (progn
        (setq pt3 '(0 100))
        (setvar "pickbox" 1)
        (command ".break" pt3 "f" pt1 pt4)
        (setvar "pickbox" pick)
     ) )
     (if (= v9 0)
       (progn
        (setq pt10 (list (/ v0 2.0) 0)
              pt11 (mapcar '+ pt10 '(0 5)))
        (command ".mirror" v10 "" pt10 pt11 "n")
        (if (and (> v4 75) (null v14))
          (progn
           (setq pt3 (list v0 100)
                 pt1 (list v0 v3)
                 pt4 (list v0 (+ v3 v4)))
           (setvar "pickbox" 1)
           (command ".break" pt3 "f" pt1 pt4)
           (setvar "pickbox" pick)
        ) )
       )
       (progn
        (setq pt6 (list v0 0)
              pt2 (list (- (car pt6) v4) v3)
              pt4 (list (- (car pt2) v6) (+ (cadr pt2) v4))
              pt3 (list (car pt4) (cadr pt2))
              pt5 (list (car pt6) (cadr pt4))
              pt1 (list (car pt2) (cadr pt6)))
        (command ".pline" pt1 pt2 pt3 pt4 pt5 pt6 "")
     ) )
    )
    (progn
     (setq pt5 '(0 0)
           pt0 (list (+ (car pt5) v4) (cadr pt5))
           pt2 (list (+ (car pt0) v6) (+ (cadr pt5) v3))
           pt3 (list (car pt2) (+ (cadr pt2) v4))
           pt4 (list (car pt5) (cadr pt3))
           pt1 (list (car pt0) (cadr pt2))
           pt9 pt2)
     (command ".pline" pt0 "w" 0 0 pt1 pt2 pt3 pt4 pt5 "")
     (if (= v9 0)
       (progn
        (setq pt1 (list v0 v3)
              pt3 (list (- (car pt1) v6) (+ (cadr pt1) v4))
              pt2 (list (car pt3) (cadr pt1))
              pt4 (list (car pt1) (cadr pt3)))
        (command ".pline" pt1 pt2 pt3 pt4 "")
        (setq pt1 (list (car pt1) (cadr pt0)))
       )
       (progn
        (setq pt10 (list (/ v0 2.0) 0)
              pt11 (mapcar '+ pt10 '(0 5)))
        (command ".mirror" "L" "" pt10 pt11 "n")
        (setq pt3 (list (+ (car pt2) v5) (cadr pt2))
              pt1 (list (+ (car pt0) v2) (cadr pt0)))
     ) )
  ) )
  (setvar "aperture" aper)
  (if (> v1 1)
    (progn
     (setq pt1 (list (+ (car pt0) v2) (cadr pt0))
           pt7 (list (+ (car pt1) v4) v3)
           pt3 (list (- (car pt1) v6) v3)
           pt5 (list (+ (car pt7) v6) (+ (cadr pt7) v4))
           pt2 (list (car pt1) (cadr pt7))
           pt8 (list (car pt7) (cadr pt1))
           pt4 (list (car pt3) (cadr pt5))
           pt6 (list (car pt5) (cadr pt3)))
     (command ".pline" pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 "")
  ) )
  (if (> v1 2) (command ".array" "L" "" "r" 1 (1- v1) (+ v2 v4)))
  (if (> v4 75)
    (progn
     (if (and (= v8 0) (= v9 0))
        (setq pt1 (list (+ (car pt0) v2) (cadr pt0))))
     (command ".pline" pt0 pt1 "")
     (if (> v1 1) (command ".array" "L" "" "r" 1 v1 (+ v2 v4)))
  ) )
  (command ".color" 3)
  (setq pt10 (list (car pt9) (- (cadr pt9) v5))
         pt4 (list (car pt3) (- (cadr pt3) v5)))
  (if (= v7 "R")
    (progn
     (if (or (< v17 v16) (> v17 (+ v16 pi)))
       (setq pt5 pt9 pt9 pt3 pt3 pt5 pt5 pt10 pt10 pt4 pt4 pt5))
     (command ".pline" pt10 pt9 "") (setq v9 (entlast))
     (command ".color" 8)
     (command ".pline" pt10 "a" "d" pt4 pt3 "") (setq v10 (entlast))
  ) )
  (if (= v7 "L")
    (progn
     (if (or (< v17 v16) (> v17 (+ v16 pi)))
       (setq pt5 pt3 pt3 pt9 pt9 pt5 pt5 pt4 pt4 pt10 pt10 pt5))
     (command ".pline" pt3 pt4 "") (setq v9 (entlast))
     (command ".color" 8)
     (command ".pline" pt4 "a" "d" pt10 pt9 "") (setq v10 (entlast))
  ) )
  (command ".color" ccol)
  (setq pt10 (list (+ (/ v2 2.0) (* v8 v4)) 50))
;  (command ".vslide" (strcat kpath "lib1/toilet"))
  (setq v12 0)
  (while (or (<= v12 0) (> v12 5))
    (progn
     (setq v12 (getint "\nType of WC = <1>/2/3/4/5: "))
     (if (null v12) (setq v12 1))
  ) )
  (if (= v12 5) (setq pt10 (mapcar '+ pt10 '(0 100))))
  (setq v12 (itoa v12))
  (redraw)
  (command ".insert" (STRCAT "toilet" v12) pt10 1 1 90)
  (setq v11 (entlast))
  (if (> v1 1) (command ".array" v9 v10 v11 "" "r" 1 v1 (+ v2 v4)))
  (command ".ucs" "p")
  (command ".layer" "s" clay "")
  (if grid (setvar "gridmode" 1))
  (if icon (setvar "ucsicon" 1))
  (setvar "blipmode" sblip)
  (command ".undo" "e")
  (princ)
)


jeepsheep

教学1

jeepsheep

教学2

jeepsheep

教学3
当隔断厚度输入100或以上都很正常，但是输入小于100就容易出问题了。
望高手帮忙完善.

jeepsheep

教学4

jeepsheep

教学5

jeepsheep

教学6

jeepsheep

教学7
必须在你的CAD的目录里有toilet1.dwg toilet2.dwg ....toilet5.dwg等五个图块，
可以把自己常用的的改名存到CAD的目录里。

jeepsheep

为了方便大家我就把图块上传，但是要收币，因为自己动手一样可以完成效果，想方便就付一个币！
压缩文件解压有五个dwg文件。

riyuecao

好东东  谢谢楼主的分享了

goguyh

分享快乐

vollen

谢谢分享

zhinay_cn

不错
好像很复杂
请问搂主搞什么专业的

KENSHIN709

已经下了，但是不会用，太复杂了。
好像还要输入墙厚之类的!
不明，只好放弃!!