立面衣柜程序，求完善！

ld80721

本人按自己绘图经验，编了个画立面的程序，lisp经验有限，写的很啰嗦，期待同仁完善。。。先谢谢了！
操作过程如图示，点选P1，再选对角P3，立面衣柜生成。到最后插入图块时，本人就不会了，求如何按实际尺寸
调整插入图块数量（如衣服数量等），谢谢！


         
(defun c:cs ()
(initget 1)
(setq p1 (getpoint "\n请选择左上角点<退出>: "))
(initget 1)
(setq p3 (getcorner p1 "\n请选择右下角点<退出>:"))
(setq h (getdist "\n请输入置放棉被格宽度<450>: "))
(setq kc (getdist "\n请输入置放棉被格宽度<500>: "))
(if (= h nil) (setq h 450))
(if (= kc nil) (setq kc 500))
(initget 1)
(setq p1x (car p1)
p1y (cadr p1)
p3x (car p3)
p3y (cadr p3)
p2  (list p3x p1y)
p4  (list p1x p3y)
            
  )
   (setq os (getvar "OSMODE"))
   (setvar "OSMODE" 0 )
;;;;;;;;;;外框
   (command "_pline" p4 p1 p2 p3 "")
   (setq s1 (entlast))
   (command "_offset" 36 (list s1 p1) (polar p1 0 1) "" )
   (command "erase" s1 "")
;;;;;;;;;;内框
    (setq k (entlast))
    (setq klist nil )
    (foreach n (entget k)
        (if (= 10 (car n))
        (setq klist (cons (cdr n) klist))  )
    )
       (setq kp1 (car klist)) ;;;;;;;;;;以下是36边框的四个顶点求值，从右下角点逆时针
       (setq kp2 (cadr klist))
       (setq kp3 (caddr klist))
    (setq kp4 (cadddr klist))
       (setq dkp1 (polar kp4 (* pi 0.5) 50));;;;;;;;;;从左至右，50高底边线
       (setq dkp2 (polar kp1 (* pi 0.5) 50))
       (command "line" dkp1 dkp2 "")
       (setq ckp1 (polar kp3 0 18));;;;;;;;;;18宽侧边框线
    (setq ckp2 (polar dkp1 0 18))
    (setq ckp3 (polar kp2 (* pi 1) 18))
    (setq ckp4 (polar dkp2 (* pi 1) 18))
    (command "line" ckp1 ckp2 "")
    (command "line" ckp3 ckp4 "")
    ;;;;;;;;;;柜体竖板绘制
    (setq shup1(polar ckp1 0 (-(/ (distance ckp1 ckp3) 2) 9)))
    (setq shup2(polar ckp2 0 (-(/ (distance ckp2 ckp4) 2) 9)))
    (setq shup3(polar ckp3 (* pi 1) (-(/ (distance ckp1 ckp3) 2) 9)))
    (setq shup4(polar ckp4 (* pi 1) (-(/ (distance ckp2 ckp4) 2) 9)))
    (command "line" shup1 shup2 "")
    (command "line" shup3 shup4 "")
    ;;;;;;;;;;柜体上端18宽侧板绘制
    (setq sckp1 (polar ckp1 (* pi 1.5) 18))
    (setq sckp2 (polar shup1 (* pi 1.5) 18))
    (setq sckp3 (polar ckp3 (* pi 1.5) 18))
    (setq sckp4 (polar shup3 (* pi 1.5) 18))
    (command "line" sckp1  sckp2  "")
    (setq s2 (entlast))
    (command "line" sckp3  sckp4  "")
    (setq s3 (entlast))
    ;;;;;;;;;;柜体下端18宽侧板绘制
    (setq xckp1 (polar ckp2 (* pi 0.5) 18))
    (setq xckp2 (polar shup2 (* pi 0.5) 18))
    (setq xckp3 (polar ckp4 (* pi 0.5) 18))
    (setq xckp4 (polar shup4 (* pi 0.5) 18))
    (command "line" xckp1  xckp2  "")
    (command "line" xckp3  xckp4  "")
   
    ;;;;;;;;;;棉被格绘制
    (command "_offset" h (list s2 sckp1) (polar sckp1 (* pi 1.5) 1) "" )
     (setq s4 (entlast))
    (command "_offset" 18 (list s4 (polar sckp1(* pi 1.5) h)) (polar (polar sckp1(* pi 1.5) h) (* pi 1.5) 1) "" )
       (command "_offset" h (list s3 sckp3) (polar sckp3 (* pi 1.5) 1) "" )
    (setq s5 (entlast))
    (command "_offset" 18 (list s5 (polar sckp3(* pi 1.5) h)) (polar (polar sckp3(* pi 1.5) h) (* pi 1.5) 1) "" )
    (setq s7 (entlast))
    ;;;;;;;;;;右下角挂衣格绘制
    (setq xgyp1 (polar xckp3 (* pi 0.5) 1000))
    (setq xgyp2 (polar xckp4 (* pi 0.5) 1000))
    (command "line" xgyp1 xgyp2  "")
    (setq s6 (entlast))
    (command "_offset" 18 (list s6 xgyp1) (polar xgyp1 (* pi 0.5) 1) "" )
    (setq s8 (entlast))
    ;;;;;;;;;;叠放衣物格绘制，求s7及s8线图元两中点坐标
    (setq s7_data(entget s7))
    (setq pts(assoc 10 s7_data))
    (setq dfpt1(cdr pts))
    (setq pte(assoc 11 s7_data))
    (setq dfpt2(cdr pte))
   
    (setq s8_data(entget s8))
    (setq pts2(assoc 10 s8_data))
    (setq dfpt3(cdr pts2))
    (setq pte2(assoc 11 s8_data))
    (setq dfpt4(cdr pte2))
     ;;;;;;;;;;求s7及s8线图元两中点坐标
    (setq mdfpt1(polar dfpt1 (* pi 1) (/ (distance dfpt1 dfpt2) 2)))
    (setq mdfpt2(polar dfpt3 (* pi 1) (/ (distance dfpt3 dfpt4) 2)))
    ;;;;;;;;;;求叠放衣物格竖板绘制
    (setq sdfpt1 (polar mdfpt1 (* pi 1) 9) )
    (setq sdfpt2 (polar mdfpt2 (* pi 1) 9) )
    (command "_line" sdfpt1 sdfpt2 "")
    (setq sdfpt3 (polar mdfpt1 0 9) )
    (setq sdfpt4 (polar mdfpt2 0 9) )
    (command "_line" sdfpt3 sdfpt4 "")
    ;;;;;;;;;;求叠放衣物格横板绘制
    ;;;;;;;;;;先左边的
    (setq zhpt1(polar dfpt2 (* pi 1.5) (-(/ (distance dfpt2 dfpt4) 2) 9)))
    (setq zhpt2(polar sdfpt1 (* pi 1.5) (-(/ (distance sdfpt1 sdfpt2) 2) 9)))
    (command "_line" zhpt1 zhpt2 "")
    (setq s9 (entlast))
    (command "_offset" 18 (list s9 zhpt1) (polar zhpt1 (* pi 1.5) 1) "" )
     ;;;;;;;;;;再右边的
    (setq yhpt1(polar dfpt1 (* pi 1.5) (-(/ (distance dfpt1 dfpt3) 2) 9)))
    (setq yhpt2(polar sdfpt3 (* pi 1.5) (-(/ (distance sdfpt3 sdfpt4) 2) 9)))
    (command "_line" yhpt1 yhpt2 "")
    (setq s10 (entlast))
    (command "_offset" 18 (list s10 yhpt1) (polar yhpt1 (* pi 1.5) 1) "" )
    ;;;;;;;;;;求裤抽格子抽绘制
    (setq kcpt1(polar xckp1(/ pi 2) 800))
    (setq kcpt2(polar xckp2(/ pi 2) 800))
    (command "_line" kcpt1 kcpt2 "")
    (setq s11 (entlast))
    (command "_offset" 18 (list s11 kcpt1) (polar kcpt1 (/ pi 2) 1) "" )
   
   
    (setq skcpt1(polar kcpt1 0 kc))
    (setq skcpt2(polar xckp1 0 kc))
    (command "_line" skcpt1 skcpt2 "")
    (setq skcpt3(polar skcpt1 0 18))
    (setq skcpt4(polar skcpt2 0 18))
    (command "_line" skcpt3 skcpt4 "")
    (setq hkcpt1(polar skcpt3 (* pi 1.5) (-(/ (distance skcpt3 skcpt4) 2) 9)))
    (setq hkcpt2(polar  kcpt2 (* pi 1.5) (-(/ (distance skcpt3 skcpt4) 2) 9)))
    (command "_line" hkcpt1 hkcpt2 "")
    (setq hkcpt3(polar skcpt3 (* pi 1.5) (+(/ (distance skcpt3 skcpt4) 2) 9)))
    (setq hkcpt4(polar  kcpt2 (* pi 1.5) (+(/ (distance skcpt3 skcpt4) 2) 9)))
    (command "_line" hkcpt3 hkcpt4 "")
      ;;;;;;;;;;格子抽绘制
  (setq gzcpt1 (polar kcpt1 (* pi 1.5) 120))
  (setq gzcpt2 (polar skcpt1 (* pi 1.5) 120))
   (command "_line" gzcpt1 gzcpt2 "")
   (setq s12 (entlast))
   (setq mpt1 (polar kcpt1 0 (/ (distance kcpt1 skcpt1) 2)) )
   (setq mpt (polar mpt1 (* pi 1.5) 30))
   (setq zpt (polar mpt1 (* pi 1) 100) )
   (setq ypt (polar mpt1 0 100) )
  
  (command "_ARC" zpt mpt ypt  "")
   ;;;;;;;;;; 裤抽绘制
   (command "_offset" 80 (list s12 gzcpt1) (polar gzcpt1 (* pi 1.5) 1) "" )
   (setq opt1 (polar (polar gzcpt1(* pi 1.5) 40) 0 60))
   (setq opt2 (polar (polar gzcpt2(* pi 1.5) 40) (* pi 1) 60))
   (command "_CIRCLE" opt1 15 "")
   (setq s13 (entlast))
   (command "_array" s13 "" "R"  "" 5 (/(distance opt1 opt2) 4) "" )
   (setq ss(ssget "w" p1 p3))
    (command "._chprop" ss "" "c" "251" "")
   ;;;;;;;;;; 各格子中透空符绘制
   (setq tp (polar (polar sckp1 (* pi 1.5) 60) 0 60))
   (setq tp1 (polar sckp1 (* pi 1.5) h))
   (command "_pline" sckp2 tp tp1  "")
   (command "._chprop" (entlast) "" "c" "250" "")
   (setq s14 (entlast))
   (setvar "OSMODE" 0 )
   (command "_COPY" s14 "" sckp1  sckp4  )
   (command "._chprop" (entlast) "" "c" "250" "")
   (setq s18 (entlast))
   (setq tp2 (polar (polar dfpt2(* pi 1.5) 60) 0 60))
   (command "_pline" sdfpt1 tp2 zhpt1  "")
   (command "._chprop" (entlast) "" "c" "250" "")
   (setq s15 (entlast))
   (command "_COPY" s15 "" zhpt1  yhpt2  )
   (command "._chprop" (entlast) "" "c" "250" "")
   (setq s19 (entlast))
   (command "_COPY" s15 "" zhpt2   sdfpt2  )
    (command "._chprop" (entlast) "" "c" "250" "")
   (setq s16 (entlast))
   (command "_COPY" s16 "" sdfpt1  dfpt1 )
   (command "._chprop" (entlast) "" "c" "250" "")
   (setq s20 (entlast))
   (setq tp3 (polar (polar skcpt3(* pi 1.5) 60) 0 60))
   (command "_pline" kcpt2 tp3 hkcpt1  "")
    (command "._chprop" (entlast) "" "c" "250" "")
   (setq s17 (entlast))
  
    (command "_COPY" s17 "" skcpt3  hkcpt3 )
  (command "._chprop" (entlast) "" "c" "250" "")
   
    (setvar "OSMODE" os)
(princ)   
)

ld80721

期待完善。。。。

ld80721

本人已经成功插入衣物图块，不过还是初级办法写的。呵呵。。。。。。
望得以高人指点，如何简化程序！

革天明

你最好使用(setq l1(dist p1 p2))这样把你的长、宽求出来，以后计算其它数据时使用(setq ln(* 0.5 l1))这样通过系数来计算，这样不论你画多大的柜，里面的东西都是成比例的。
里面重复的东西最好以块的形式插入，再炸开，这些块最好是dwg格式的

ld80721

有些边框是固定尺寸好像没办法用你的方法，不知还有更适合的办法?

ld80721

各位，除了我这个方法外还有更简便的法子没！

写不完的日记

厉害！