明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1262|回复: 0

[基础] [求助]plz chk program & suggestion me how to imrove

[复制链接]
发表于 2010-8-11 20:15:00 | 显示全部楼层 |阅读模式
Dear All
plz chk program & suggestion me how to imrove
program run only mm drg
System Variables not restore what's problem
door lisp
  1. (DEFUN C:DR (/ lu a b c d e f g pt pp pt1 pt2 p ang1 tz wl ds wt sw ang2
  2. pt3 pt4 ang3 pl2 pl3 pl4 pl5 pl6 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt13 pt14 pt15)
  3.   (SETVAR "BLIPMODE" 0)
  4. (SETVAR "OSMODE" 512)
  5. (setq lu (getvar "lunits"))
  6. (if (= lu 2) (setq a 75 b 82 c 15 d 38 e 60 f 120 g 150)
  7. (setq a 3 b 3.5 c 0.5 d 1.5 e 2.5 f 5 g 6))
  8.    (if (null DRlay)
  9.     (progn
  10.        (setq DRlay "DR")
  11.        (setq DRlayer (tblsearch "layer" DRlay))
  12.      (if (null DRlayer)
  13.          (progn
  14.            (setq DRlay (getstring "\nLayer name for TEXT : "))
  15.            (setq DRclr (getstring (strcat "\nColor for " DRlay " layer: ")))
  16.            (command "layer" "m" DRlay "c" DRclr "" "")
  17.          )
  18.        (prompt "\nDOOR ON DR LAYER")
  19.      )
  20.     )
  21.    )
  22. (SETQ PT (entsel "\nPICK WALL LINE:"))
  23. (setq pp (CDR (ASSOC 11 (ENTGET (CAR PT)))))
  24. (setvar "osmode" 128)
  25. (SETQ PT1 (GETPOINT PP "\nEnter Insertion Point:"))
  26. (SETQ PT2 (GETPOINT PT1 "\nPick Opposite Wall Line:"))
  27. (SETVAR "OSMODE" 512)
  28. (SETQ p (GETpoint PT2 "\nPICK THE SIDE FOR OPENING:"))
  29. (setq ang1 (angle pt2 p))
  30. (IF (null DZ) (SETQ DZ "900"))
  31. (SETQ TZ (STRCASE (GETSTRING (STRCAT "\nENTER SIZE OF OPENING <" DZ ">: ")) t))
  32. (IF (/= TZ "") (SETQ DZ TZ))
  33. (SETVAR "BLIPMODE" 0)
  34. (setq wl (cdr (assoc 8 (entget (car pt)))))
  35. (SETQ DS (Atof DZ))
  36. (SETQ WT (DISTANCE PT1 PT2))
  37. (SETQ SW (- DS f))
  38. (SETQ ANG2 (ANGLE PT1 PT2))
  39. (SETQ PT3 (POLAR PT1 ANG1 DS))
  40. (SETQ PT4 (POLAR PT3 ANG2 WT))
  41. (SETQ ANG3 (ANGLE PT3 PT1))
  42. (SETQ PL2 (POLAR PT1 ANG1 a))
  43. (SETQ PL3 (POLAR PL2 ANG2 b))
  44. (SETQ PL4 (POLAR PL3 ANG3 c))
  45. (SETQ PL5 (POLAR PL4 ANG2 d))
  46. (SETQ PL6 (POLAR PL5 ANG3 e))
  47. (SETQ PT5 (POLAR PT1 ANG1 (/ DS 2)))
  48. (SETQ PT6 (POLAR PT5 ANG2 f))
  49. (SETQ PT7 (POLAR PL5 ANG1 SW))
  50. (SETQ PT12 PT7 PT13 PL5)  
  51. (SETVAR "OSMODE" 0)
  52. (COMMAND "BREAK" Pt "F" PT1 PT3)
  53. (COMMAND "BREAK" P "F" PT2 PT4)
  54. (COMMAND "LAYER" "s" WL "")
  55. (COMMAND "LINE" PT1 PT2 "")
  56. (COMMAND "LINE" PT3 PT4 "")
  57. (COMMAND "COLOR" "BYLAYER")
  58. (COMMAND "LAYER"  "t" drlay "on" drlay "s" drlay "")
  59. (COMMAND "PLINE" PT1 PL2 PL3 PL4 PL5 PL6 "")
  60. (COMMAND "MIRROR" PL2 "" PT5 PT6 "")
  61. (SETVAR "ORTHOMODE" 0)
  62. (SETQ PT11 (GETPOINT PT5 "\nPICK THE SIDE FOR SHUTTER:"))
  63. (IF (> (DISTANCE PT11 PL5)(DISTANCE PT7 PT11)) (SETQ PL5 PT7 PT12 PT13))
  64. (SETQ PT8 (POLAR PL5 (ANGLE PL5 PT6) d))
  65. (SETQ PT9 (POLAR PT8 ANG2 SW))
  66. (SETQ PT10 (POLAR PT9 (ANGLE PT6 PL5) d))
  67. (COMMAND "PLINE" PL5 PT8 PT9 PT10 PL5 "")
  68. (COMMAND "ARC" PT12 PT9 PT10)
  69. (COMMAND "CHPROP" "L" "" "LT" "HIDDEN2" "")
  70. (setq pt14 (polar pl3 ang1 (- ds g)))
  71. (setq pt15 (polar pl2 ang1 (- ds g)))
  72. (if (and (>= ds 100) (<= ds 750)) (command "line" pl3 pt14 ""))
  73. (if (>= ds 910) (command "line" pl2 pt15 ""))
  74. (if (<= ds 32) (command "line" pl3 pt14 ""))
  75. (if (and (>= ds 37) (< ds 100)) (command "line" pl2 pt15 ""))
  76. )
window lisp
  1. (defun wwerr (msg)
  2.   (setq offd nil win_l nil )
  3.   (setvar "osmode" os)
  4.   (setvar "pickbox" pb)
  5.   (command "layer" "s" clay "")
  6.   (setvar "cmdecho" 1)
  7.   (if wwolderr (setq *error* wwolderr wwolderr nil))
  8. )
  9. (defun ww  (/ wwlayer wwclr  os clay pb lu jmb_w lin lin_ent lin_pp splin eplin
  10.              mplin spd epd mpd d_min _pt1 lin_l wl_lay _ang1 _pto _ang2 _ang3
  11.              wal_thk offdt win_lt _pt2 _ang4 o_pt1 o_pt2 j_of j_p1 j_p2 j_p3
  12.              j_p4 j_p5 j_p6 j_p7 j_p8)
  13. ()
  14. (if *error* (setq wwolderr *error* *error* wwerr) (setq *error* wwerr))
  15. (if (null wwlay)
  16.        (progn
  17.          (setq wwlay "window")
  18.          (setq wwlayer (tblsearch "layer" wwlay))
  19.          (if (null wwlayer)
  20.              (progn
  21.               (setq wwlay (getstring "\nLayer name for WINDOW : "))
  22.               (if (tblsearch "layer" wwlay)
  23.                   (prompt (strcat"\nWindow on " wwlay " layer.."))
  24.                   (progn
  25.                     (prompt (strcat"\nColor for " wwlay " layer : "))
  26.                     (setq wwclr (acad_colordlg 72))
  27.                     (command "layer" "n" wwlay "c" wwclr  wwlay  "")
  28.                   )
  29.               )   
  30.              )
  31.              (prompt "\nWINDOW ON WD LAYER")
  32.          )
  33.        )
  34.    )
  35.   (setq os   (getvar "osmode")
  36.         clay (getvar "clayer")
  37.         pb   (getvar "pickbox")
  38.         lu   (getvar "lunits")
  39.   )
  40.   (if (= lu 2) (setq jmb_w 35) (setq jmb_w 1.5))
  41.   (setvar "cmdecho" 0)
  42.   (setvar "osmode" 512)
  43.   (setq lin (entsel "\nSelect wall : "))
  44.   (setq lin_ent (entget (car lin))
  45.         lin_pp  (cadr lin)
  46.   )
  47.   (setq splin  (cdr (assoc 10 lin_ent))
  48.         eplin  (cdr (assoc 11 lin_ent))
  49.         mplin  (osnap lin_pp "midp")
  50.         lin_pp (osnap lin_pp "nea")
  51.   )
  52.   (setq spd (distance splin lin_pp)
  53.         epd (distance eplin lin_pp)
  54.         mpd (distance mplin lin_pp)
  55.   )
  56.   (setq d_min (min spd epd mpd))
  57.   (if (= d_min spd) (setq _pt1 splin))
  58.   (if (= d_min epd) (setq _pt1 eplin))
  59.   (if (= d_min mpd) (setq _pt1 mplin))
  60.   (setq lin_l (distance eplin splin)
  61.         wl_lay (cdr (assoc 8 lin_ent))
  62.         _ang1 (angle _pt1 mplin)
  63.   )
  64.   ;;;;;;;;;;;;;; offd= offset from endpoint;;;;;;;;;;;;;;;;
  65.   (setvar "osmode" 128)
  66.   (setq _pto  (getpoint lin_pp "\nSelect opposite wall : "))
  67.   (setq _ang2 (angle lin_pp _pto)
  68.         _ang3 (angle _pto lin_pp)
  69.         wal_thk (distance lin_pp _pto)
  70.   )
  71.   (if (or (= d_min spd) (= d_min epd))
  72.       (progn
  73.         (if (null offd)
  74.             (setq offd "600")
  75.             (setq offd (rtos offd lu 2))
  76.         )
  77.         (setq offdt (getdist _pt1 (strcat "\nOffset distance < " offd " > : ")))
  78.         (if (not offdt) (setq offd (atof offd)) (setq offd offdt))
  79.         (if (or (not offd) (=  offd  0) (zerop offd) )
  80.             (setq _pt1 _pt1)
  81.             (setq _pt1 (polar _pt1 _ang1 offd))
  82.         )
  83.       )
  84.   )
  85.   ;;;;;;;;;;;;;;win_l = window length;;;;;;;;;;;;;;;;;;;;;;;
  86.   (if (null win_l)
  87.       (setq win_l (rtos (- lin_l 600) lu 2))
  88.       (setq win_l (rtos win_l lu 2))
  89.   )
  90.   (setq win_lt (getdist _pt1 (strcat "\nWindow length < " WIN_L  " > : ")))
  91.   (if (not  win_lt)
  92.       (setq win_l (atof win_l))
  93.       (setq win_l win_lt)
  94.   )
  95.   ;;;;;;;;;;;;;points;;;;;;;;;;;;;;;;;;
  96.   (if (= d_min mpd)
  97.       (setq _pt1 (polar mplin (angle eplin splin) (/ win_l 2))
  98.             _pt2 (polar mplin (angle splin eplin) (/ win_l 2))  
  99.       )      
  100.       (setq _pt2 (polar _pt1  _ang1 win_l))
  101.   )
  102.   (setq _ang1 (angle _pt1 _pt2)
  103.         _ang4 (angle _pt2 _pt1)
  104.   )
  105.   (setq _ang5 (angle _pt2 _pt1)
  106.         _ang6 (angle _pt1 _pt2)
  107.   )
  108.   (setq o_pt1 (polar _pt1 _ang2 wal_thk)
  109.         o_pt2 (polar _pt2 _ang2 wal_thk)
  110.         j_of  (/ wal_thk 2.75)
  111.         j_p1  (polar _pt1 _ang2 j_of)
  112.         j_p2  (polar j_p1 _ang1 jmb_w)
  113.         j_p4  (polar o_pt1 _ang3 j_of)
  114.         j_p3  (polar J_p4 _ang1 jmb_w)
  115.         j_p5  (polar _pt2 _ang2 j_of)
  116.         j_p6  (polar j_p5 _ang4 jmb_w)
  117.         j_p8  (polar o_pt2 _ang3 j_of)
  118.         j_p7  (polar J_p8 _ang4 jmb_w)
  119.   )
  120.   (setvar "osmode" 0)
  121.   (setvar "pickbox" 1)
  122.   (command  "break" lin_pp "f" _pt1 _pt2
  123.             "break" _pto "f" o_pt1 o_pt2)
  124.             
  125.   (joint _pt2 o_pt2 wal_thk _ang6 wl_lay)
  126.   (joint _pt1 o_pt1 wal_thk _ang5 wl_lay)
  127.   (command  "layer" "t" wwlay  "on" wwlay "s" wwlay ""
  128.             "pline" j_p1 j_p2 j_p3 j_p4 "c"
  129.             "pline" j_p5 j_p6 j_p7 j_p8 "c"
  130.             "line"  j_p2 j_p6 ""
  131.             "line"  j_p3 j_p7 ""
  132.             "line" _pt1 _pt2 ""
  133.             "line" o_pt1 o_pt2 ""
  134.   )
  135.   (setvar "pickbox" pb)
  136.   (setvar "osmode" os)
  137.   (command "layer" "s" clay "")
  138.   (if wwolderr (setq *error* wwolderr wwolderr nil) (setq *error* nil))
  139.   (sk)
  140.   (setvar "cmdecho" 1)
  141. )
  142. (defun joint (jt1 jt2 wlt angw walay / ang1 ang2 pt10 pt11 pt12 pt13 ch10
  143.               ch11 ch12 ch13 ch11_ent ch12_ent ch11_ep ch11_sp ch12_sp ch12_ep
  144.               sub12e sub12s sub11e sub11s 14_ep 14_sp)
  145. (setq ang1 (+ angw (dtr 90)))
  146. (setq ang2 (- angw (dtr 90)))
  147. (setq pt10  (polar jt1 angw (/ wlt 2))
  148.        pt11  (polar jt1 ang1 (* wlt 1.2))
  149.        pt12  (polar jt1 ang2 (* wlt 1.2))
  150.        pt13  (polar jt2 angw (/ wlt 2))
  151. )
  152. (command "layer" "s" walay "")
  153. (setq ch10  (ssget pt10 (list (cons 8 walay))))
  154. (setq ch13  (ssget pt13 (list (cons 8 walay))))
  155. (setq ch11  (ssget pt11 (list (cons 8 walay))))
  156. (setq ch12  (ssget pt12 (list (cons 8 walay))))
  157. (if (and ch10 ch13)
  158.      (command "line" jt1 jt2 "")
  159.      (progn
  160.        (if (and ch10 ch11) (command "fillet" pt10 pt11 ) )
  161.        (if (and ch10 ch12) (command "fillet" pt10 pt12 ) )
  162.        (if (and ch13 ch11) (command "fillet" pt13 pt11 ) )
  163.        (if (and ch13 ch12) (command "fillet" pt13 pt12 ) )
  164.        (if (and ch11 ch12)
  165.          (progn
  166.            (setq ch11_ent (entget (ssname ch11 0)))
  167.            (setq ch12_ent (entget (ssname ch12 0)))
  168.            (setq ch11_ep  (cdr (setq sub11e (assoc 10 ch11_ent))))
  169.            (setq ch11_sp  (cdr (setq sub11s (assoc 11 ch11_ent))))
  170.            (setq ch12_ep  (cdr (setq sub12e (assoc 10 ch12_ent))))
  171.            (setq ch12_sp  (cdr (setq sub12s (assoc 11 ch12_ent))))
  172.            (if (< (distance pt11 ch11_sp) (distance pt11 ch11_ep))
  173.                (setq 14_ep ch11_ep)
  174.                (setq 14_ep ch11_sp)
  175.            )
  176.            (if (< (distance pt12 ch12_sp) (distance pt12 ch12_ep))
  177.                (setq 14_sp ch12_ep)
  178.                (setq 14_sp ch12_sp)
  179.            )
  180.            (command "erase" pt12 "")
  181.            (entmod (subst (cons 10 14_ep) sub11e ch11_ent))
  182.            (entmod (subst (cons 11 14_sp) sub11s ch11_ent))
  183.          )
  184.        )
  185.      )
  186. )
  187. )
  188. (defun c:wwnl () (setq wwlay nil) (ww))
  189. (defun c:ww () (WW) )
"觉得好,就打赏"
还没有人打赏,支持一下
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-10-2 08:33 , Processed in 0.178294 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表