明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
12
返回列表 发新帖
楼主: sefiroth

求各位高手帮忙啊!!!!!!

[复制链接]
发表于 2009-1-5 21:18:00 | 显示全部楼层

修改了dcsmb-z.LSP文件后,经调试没有问题了!!
  1. ;;;***********************************
  2. ;;;   主 程 序 --By 冯超     2008.12  
  3. ;;;***********************************
  4. (defun C:DCSMB-z()
  5.   (init_jx)
  6.   (dcldrv_jx);加载对话框.
  7.   (revert_jx)
  8. );end_defun
  9. (defun init_jx()
  10.   (vl-load-com)
  11.   (setq os (getvar "osmode"))
  12.   (setvar "osmode" 0)
  13.   (setvar "cmdecho" 0)
  14. )
  15. ;;;******************************
  16. ;;; 1. 主对话框加载/初始化 函数  
  17. ;;;******************************
  18. (defun dcldrv_jx(/ aa ss xhlist f1 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10
  19.          p11 p12 p13 p14 p15 p16 p17 p18 p19 p20 p21
  20.   p22 p23 p24 p25 p26 p27 p28 p29 p30 p31 p32 p33
  21.          p34 p35 p36 p37 p38 p39 p40 p41 p42 p43 p44 p45
  22.          p46 p47 p48 p49 p50 ikey inam x y Alis Blis Hlis
  23.          Dlis ddlis Clis Elis Llis B1lis hhlis Rlis  Klis listlist pzong)
  24.   (setq aa (load_dialog "d:\\参数绘图\\dcsmb-z\\dcsmb-z.DCL"))
  25.                 (setq jieshou "accept")
  26.   
  27. ;为下拉列表框显示做数据准备
  28.   (setq xhlist(list " 60x50x25"
  29.                     " 80x60x25"
  30.       " 80x60x30"
  31.       "100x80x30"
  32.       "100x80x35"
  33.       "120x80x30"
  34.       "120x80x35"
  35.       "140x80x30"
  36.       "140x80x35"
  37.       "170x80x30"
  38.       "170x80x35"
  39.       "120x100x30"
  40.       "120x100x35"
  41.       "140x100x30"
  42.       "140x100x35"
  43.       "170x100x35"
  44.       "170x100x40"
  45.       "200x100x35"
  46.       "200x100x40"
  47.       "140x120x35"
  48.       "140x120x40"
  49.       "170x120x35"
  50.       "170x120x40"
  51.       "200x120x35"
  52.       "200x120x40"
  53.                     "250x120x35"
  54.       "250x120x40"
  55.       "170x140x35"
  56.       "170x140x40"
  57.       "200x140x40"
  58.                     "200x140x45"
  59.       "250x140x40"
  60.       "250x140x45"
  61.       "300x140x40"
  62.       "300x140x45"
  63.       "200x170x40"
  64.       "200x170x45"
  65.       "250x170x40"
  66.       "250x170x45"
  67.       "300x200x45"
  68.       "300x200x50"
  69.       "350x200x45"
  70.       "350x200x50"
  71.       "350x250x45"
  72.       "350x250x50"
  73.       "400x300x55"
  74.       ))
  75. ;从外挂数据文件读入参数
  76.   (setq f1  (open "d:\\参数绘图\\dcsmb-z\\dcsmb-z.dat" "r"))
  77.   (setq p1  (read-line f1))
  78.   (setq p2  (read-line f1))
  79.   (setq p3  (read-line f1))
  80.   (setq p4  (read-line f1))
  81.   (setq p5  (read-line f1))
  82.   (setq p6  (read-line f1))
  83.   (setq p7  (read-line f1))
  84.   (setq p8  (read-line f1))
  85.   (setq p9  (read-line f1))
  86.   (setq p10 (read-line f1))
  87.   (setq p11 (read-line f1))
  88.   (setq p12 (read-line f1))
  89.   (setq p13 (read-line f1))
  90.   (setq p14 (read-line f1))
  91.   (setq p15 (read-line f1))
  92.   (setq p16 (read-line f1))
  93.   (setq p17 (read-line f1))
  94.   (setq p18 (read-line f1))
  95.   (setq p19 (read-line f1))
  96.   (setq p20 (read-line f1))
  97.   (setq p21 (read-line f1))
  98.   (setq p22 (read-line f1))
  99.   (setq p23 (read-line f1))
  100.   (setq p24 (read-line f1))
  101.   (setq p25 (read-line f1))
  102.   (setq p26 (read-line f1))
  103.   (setq p27 (read-line f1))
  104.   (setq p28 (read-line f1))
  105.   (setq p29 (read-line f1))
  106.   (setq p30 (read-line f1))
  107.   (setq p31 (read-line f1))
  108.   (setq p32 (read-line f1))
  109.   (setq p33 (read-line f1))
  110.   (setq p34 (read-line f1))
  111.   (setq p35 (read-line f1))
  112.   (setq p36 (read-line f1))
  113.   (setq p37 (read-line f1))
  114.   (setq p38 (read-line f1))
  115.   (setq p39 (read-line f1))
  116.   (setq p40 (read-line f1))
  117.   (setq p41 (read-line f1))
  118.   (setq p42 (read-line f1))
  119.   (setq p43 (read-line f1))
  120.   (setq p44 (read-line f1))
  121.   (setq p45 (read-line f1))
  122.   (setq p46 (read-line f1))
  123.   (setq p47 (read-line f1))
  124.   (setq p48 (read-line f1))
  125.   (setq p49 (read-line f1))
  126.   (setq p50 (read-line f1))
  127.   (close f1)      
  128. ;对话框初始化定义
  129.            (setq ss 2)
  130.     (while (>= ss 2)
  131.     (if (not (new_dialog "dcsmb" aa)) (exit))
  132.       
  133. ;图像框初始显示
  134.    
  135.   (imgfa_jx "shitu" "d:\\参数绘图\\dcsmb-z\\dcsmb-z-f.sld")
  136.       
  137. ;加载下拉列表框显示
  138.   (set_tile "xinghao" "0")
  139.   (end_list)
  140.   (start_list "xinghao")
  141.   (mapcar 'add_list xhlist)
  142.   (end_list)
  143.       
  144. ;定义单选开关;复选开关;下拉列表框的响应
  145.   (mode_tile jieshou 1)
  146.   (action_tile "main"      "(setq stdraw 1)(imgfa_jx"shitu""inam")")
  147.   (action_tile "assi"      "(setq stdraw 2)(imgfa_jx"shitu""inam")")
  148.   (action_tile "standa"    "(demand_jx)")
  149.   (action_tile "xinghao"   "(display_jx)")
  150.   (action_tile "blockyn"   "(setq blockyn $value)")
  151.   (action_tile "accept"    "(done_dialog 1)")
  152.   (setq ss (start_dialog))
  153.   (if (= ss 1)(draw_jx)(revert_jx))
  154.    )
  155.   (unload_dialog aa)
  156.    )
  157. ;选择显示幻灯片******************************************
  158. (defun imgfa_jx(ikey inam)
  159.     (setq ikey "shitu")
  160.     (if(= stdraw 1)(setq inam "d:\\参数绘图\\dcsmb-z\\dcsmb-z-z.sld")
  161.                    (setq inam "d:\\参数绘图\\dcsmb-z\\dcsmb-z-f.sld"))
  162.     (start_image "shitu")
  163.     (setq x (dimx_tile "shitu") y (dimy_tile "shitu"))
  164.     (fill_image 0 0 x y 0)
  165.     (slide_image 0 0 x y inam)
  166.     (end_image)
  167.      )
  168. ;显示选择的型号所对应的主要参数**************************
  169. (defun display_jx()
  170.   (setq  xh (get_tile "xinghao"))
  171.   (cond ((= xh "0")    (setq shuju1  p1))
  172.         ((= xh "1")    (setq shuju1  p2))
  173.         ((= xh "2")    (setq shuju1  p3))
  174.         ((= xh "3")    (setq shuju1  p4))
  175.         ((= xh "4")    (setq shuju1  p5))
  176.         ((= xh "5")    (setq shuju1  p6))
  177.         ((= xh "6")    (setq shuju1  p7))
  178.         ((= xh "7")    (setq shuju1  p8))
  179.         ((= xh "8")    (setq shuju1  p9))
  180.         ((= xh "9")    (setq shuju1  p10))
  181.         ((= xh "10")   (setq shuju1  p11))
  182.         ((= xh "11")   (setq shuju1  p12))
  183.         ((= xh "12")   (setq shuju1  p13))
  184.         ((= xh "13")   (setq shuju1  p14))
  185.         ((= xh "14")   (setq shuju1  p15))
  186.         ((= xh "15")   (setq shuju1  p16))
  187.         ((= xh "16")   (setq shuju1  p17))
  188.         ((= xh "17")   (setq shuju1  p18))
  189.         ((= xh "18")   (setq shuju1  p19))
  190.         ((= xh "19")   (setq shuju1  p20))
  191.         ((= xh "20")   (setq shuju1  p21))
  192.         ((= xh "21")   (setq shuju1  p22))
  193.         ((= xh "22")   (setq shuju1  p23))
  194.         ((= xh "23")   (setq shuju1  p24))
  195.         ((= xh "24")   (setq shuju1  p25))
  196.         ((= xh "25")   (setq shuju1  p26))
  197.         ((= xh "26")   (setq shuju1  p27))
  198.         ((= xh "27")   (setq shuju1  p28))
  199.         ((= xh "28")   (setq shuju1  p29))
  200.         ((= xh "29")   (setq shuju1  p30))
  201.         ((= xh "30")   (setq shuju1  p31))
  202.         ((= xh "31")   (setq shuju1  p32))
  203. ((= xh "32")   (setq shuju1  p33))
  204.         ((= xh "33")   (setq shuju1  p34))
  205.         ((= xh "34")   (setq shuju1  p35))
  206.         ((= xh "35")   (setq shuju1  p36))
  207.         ((= xh "36")   (setq shuju1  p37))
  208.         ((= xh "37")   (setq shuju1  p38))
  209.         ((= xh "38")   (setq shuju1  p39))
  210.         ((= xh "39")   (setq shuju1  p40))
  211.         ((= xh "40")   (setq shuju1  p41))
  212.         ((= xh "41")   (setq shuju1  p42))
  213.         ((= xh "42")   (setq shuju1  p43))
  214.         ((= xh "43")   (setq shuju1  p44))
  215.         ((= xh "44")   (setq shuju1  p45))
  216.         ((= xh "45")   (setq shuju1  p46)))
  217.   (setq Llis  (strcat "L    " (substr shuju1  1 3))
  218.         Blis  (strcat "B    " (substr shuju1  7 3))
  219.         Hlis  (strcat "H     " (substr shuju1 14 2))
  220.         hhlis  (strcat "h     " (substr shuju1 19 2))
  221.         L1lis (strcat "L1   " (substr shuju1 24 3))
  222.         B1lis  (strcat "B1   " (substr shuju1 29 3))
  223.         Clis  (strcat "C    " (substr shuju1 35 3))
  224.         Rlis  (strcat "R    " (substr shuju1 42 2))
  225.         R11lis (strcat "R1   " (substr shuju1 48 2))
  226.         lllis (strcat "l    " (substr shuju1 52 3))
  227.         dlis  (strcat "d     "(substr shuju1 59 2))
  228.         d1lis  (strcat"d1    " (substr shuju1 64 2))
  229.         )
  230.   (setq listlist (list Llis Blis Hlis hhlis L1lis B1lis Clis dlis d1lis ))
  231.       (start_list "paralist")
  232.       (mapcar 'add_list listlist)
  233.       (end_list)
  234.       (mode_tile jieshou 0)
  235.     )
  236. ;查询详细参数子对话框**********************************
  237. (defun demand_jx()
  238.   (setq pzong (list p1 p2 p3 p4  p5 p6 p7 p8 p9 p10
  239.          p11 p12 p13 p14 p15 p16 p17 p18 p19 p20 p21
  240.   p22 p23 p24 p25 p26 p27 p28 p29 p30 p31 p32 p33
  241.          p34 p35 p36 p37 p38 p39 p40 p41 p42 p43 p44 p45
  242.          p46 p47 p48 p49 p50))
  243.   (if (not (new_dialog "para" aa))(exit))
  244.   (start_list "parlis")
  245.   (mapcar 'add_list pzong)
  246.   (end_list)
  247.   (start_dialog)
  248.   )
  249. ;绘图程序++++++++++++++++++++++++++++++++++++++++++++++++
  250. (defun draw_jx()
  251.         (evaluate_jx)
  252.   (cond ((= stdraw 1) (dcsmb_draw2_jx))
  253.         ((/= stdraw 1)  (dcsmb_draw1_jx))
  254.         )
  255. )
  256. ;赋值****************************************************
  257. (defun evaluate_jx()
  258.     (if (/= blockyn "1") (setq blockyn "0"))  
  259.     (setq L  (atof (substr shuju1  1 3)))
  260.     (setq B  (atof (substr shuju1  7 3)))
  261.     (setq H  (atof (substr shuju1 14 2)))
  262.     (setq hh (atof (substr shuju1 19 2)))
  263.     (setq L1 (atof (substr shuju1 24 3)))
  264.     (setq B1 (atof (substr shuju1 29 3)))
  265.     (setq C  (atof (substr shuju1 35 3)))
  266.     (setq R  (atof (substr shuju1 42 2)))
  267.     (setq R1 (atof (substr shuju1 48 2)))
  268.     (setq ll (atof (substr shuju1 52 3)))
  269.     (setq d  (atof (substr shuju1 59 2)))
  270.     (setq d1 (atof (substr shuju1 64 2)))
  271.             )
  272. ;;;************************
  273. ;;; 4. 绘制俯视图 函数     
  274. ;;;************************
  275. (defun dcsmb_draw1_jx( /  sp ss1
  276.      ax0 ax1 ax2 ax3 ax4 ax5 ax6 ax7 ax8 ax9 ax10 ax11 ax12 ax13 ax14 ax15 ax16 ax17 ax18 ax19 ax20 ax21 ax22 ax23
  277.      ax24 ax25 ax26 ax27 ax28 ax29 ax30 ax31 ax32 ax33 ax34 ax35 ax36 ax37 ax38 ax39 ax40 ax41 ax42
  278.      ay0 ay1 ay2 ay3 ay4 ay5 ay6 ay7 ay8 ay9 ay10 ay11 ay12 ay13 ay14 ay15 ay16 ay17 ay18 ay19 ay20 ay21 ay22 ay23
  279.      ay24 ay25 ay26 ay27 ay28 ay29 ya30 ay31 ay32 ay33 ay34 ay35 ay36 ay37 ay38 ay39 ay40 ay41 ay42
  280.      p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13 p14 p15 p16 p17 p18 p19 p20 p21 p22 p23 p24 p25 p26 p27 p28
  281.      p29 p30 p31 p32 p33 p34 p35 p36 p37 p38 p39 p40 p41 p42)
  282.   
  283.   ;定义关键点
  284.   (setq sp (getvar "viewctr"))
  285.   (setq ax0 (car sp))
  286.   (setq ay0 (cadr sp))
  287.   (setq p0 (list ax0 ay0))
  288.   (setq ax1 (- ax0 (/ c 2.0)))
  289.   (setq ay1 ay0)
  290.   (setq p1 (list ax1 ay1))
  291.   (setq ax2 (+ ax0 (/ c 2.0)))
  292.   (setq ay2 ay0)
  293.   (setq p2 (list ax2 ay2))
  294.   (setq ax3 ax1)
  295.   (setq ay3 (+ ay0 R))
  296.   (setq p3 (list ax3 ay3))
  297.   (setq ax4 ax2)
  298.   (setq ay4 ay3)
  299.   (setq p4 (list ax4 ay4))
  300.   (setq ax5 ax1)
  301.   (setq ay5 (- ay0 R))
  302.   (setq p5 (list ax5 ay5))
  303.   (setq ax6 ax2)
  304.   (setq ay6 ay5)
  305.   (setq p6 (list ax6 ay6))
  306.   (setq ax7 (- ax0 (/ L 2.0)))
  307.   (setq ay7 (+ ay0 (/ B 2.0)))
  308.   (setq p7 (list ax7 ay7))
  309.   (setq ax8 (+ ax0 (/ L 2.0)))
  310.   (setq ay8 ay7)
  311.   (setq p8 (list ax8 ay8))
  312.   (setq ax9 ax7)
  313.   (setq ay9 (- ay0 (/ B 2.0)))
  314.   (setq p9 (list ax9 ay9))
  315.   
  316.   (setq ax10 ax8)
  317.   (setq ay10 ay9)
  318.   (setq p10 (list ax10 ay10))
  319.   (setq ax11 (+ (- ax0 (/ L1 2)) R1))
  320.   (setq ay11 (+ ay0 (/ B1 2.0)))
  321.   (setq p11 (list ax11 ay11))
  322.   (setq ax12 (- (+ ax0 (/ L1 2)) R1))
  323.   (setq ay12 ay11)
  324.   (setq p12 (list ax12 ay12))
  325.   (setq ax13 ax11)
  326.   (setq ay13 (- ay0 (/ B1 2.0)))
  327.   (setq p13 (list ax13 ay13))
  328.   (setq ax14 ax12)
  329.   (setq ay14 ay13)
  330.   (setq p14 (list ax14 ay14))
  331.   (setq ax15 (- ax0 (/ L1 2.0)))
  332.   (setq ay15 (- ay11 R1))
  333.   (setq p15 (list ax15 ay15))
  334.   (setq ax16 (+ ax0 (/ L1 2.0)))
  335.   (setq ay16 ay15)
  336.   (setq p16 (list ax16 ay16))
  337.   (setq ax17 ax15)
  338.   (setq ay17 (+ ay13 R1))
  339.   (setq p17 (list ax17 ay17))
  340.   (setq ax18 ax16)
  341.   (setq ay18 ay17)
  342.   (setq p18 (list ax18 ay18))
  343.   (setq ax19 (- ax1 (/ d1 2.0) 5.0))
  344.   (setq ay19 ay1)
  345.   (setq p19 (list ax19 ay19))
  346.   (setq ax20 (+ ax1 (/ d1 2.0) 5.0))
  347.   (setq ay20 ay1)
  348.   (setq p20 (list ax20 ay20))
  349.   (setq ax21 ax1)
  350.   (setq ay21 (+ ay1 (/ d1 2.0) 5.0))
  351.   (setq p21 (list ax21 ay21))
  352.   (setq ax22 ax1)
  353.   (setq ay22 (- ay1 (/ d1 2.0) 5.0))
  354.   (setq p22 (list ax22 ay22))
  355.   (setq ax23 (- ax2 (/ d1 2.0) 5.0))
  356.   (setq ay23 ay2)
  357.   (setq p23 (list ax23 ay23))
  358.   (setq ax24 (+ ax2 (/ d1 2.0) 5.0))
  359.   (setq ay24 ay2)
  360.   (setq p24 (list ax24 ay24))
  361.   (setq ax25 ax2)
  362.   (setq ay25 (+ ay2 (/ d1 2.0) 5.0))
  363.   (setq p25 (list ax25 ay25))
  364.   (setq ax26 ax2)
  365.   (setq ay26 (- ay2 (/ d1 2.0) 5.0))
  366.   (setq p26 (list ax26 ay26))
  367.   (setq ax27 ax0)
  368.   (setq ay27 (+ ay11 10.0))
  369.   (setq p27 (list ax27 ay27))
  370.   (setq ax28 ax0)
  371.   (setq ay28 (- ay13 10.0))
  372.   (setq p28 (list ax28 ay28))
  373.   (setq ax29 (- ax15 10.0))
  374.   (setq ay29 ay0)
  375.   (setq p29 (list ax29 ay29))
  376.   
  377.   (setq ax30 (+ ax16 10.0))
  378.   (setq ay30 ay0)
  379.   (setq p30 (list ax30 ay30))
  380.   (setq ax31 (+ ax0 (/ ll 2)))
  381.   (setq ay31 (- ay13 3))
  382.   (setq p31 (list ax31 ay31))
  383.   (setq ax32 (- ax0 (/ ll 2)))
  384.   (setq ay32 ay31)
  385.   (setq p32 (list ax32 ay32))
  386.   (setq ax33 (+ ax31 3))
  387.   (setq ay33 ay13)
  388.   (setq p33 (list ax33 ay33))
  389.   (setq ax34 (- ax32 3))
  390.   (setq ay34 ay13)
  391.   (setq p34 (list ax34 ay34))
  392.   (setq ax35 (- ax1 (sqrt (- (/ (* d d) 4) 9))))
  393.   (setq ay35 (+ ay1 3))
  394.   (setq p35 (list ax35 ay35))
  395.   (setq ax36 ax35)
  396.   (setq ay36 (- ay1 3))
  397.   (setq p36 (list ax36 ay36))
  398.   (setq ax37 (- ax1 (sqrt (- (* R R) 9))))
  399.   (setq ay37 ay35)
  400.   (setq p37 (list ax37 ay37))
  401.   (setq ax38 ax37)
  402.   (setq ay38 ay36)
  403.   (setq p38 (list ax38 ay38))
  404.   (setq ax39 (+ ax2 (sqrt (- (/ (* d1 d1) 4) 9))))
  405.   (setq ay39 (+ ay1 3))
  406.   (setq p39 (list ax39 ay39))
  407.   (setq ax40 ax39)
  408.   (setq ay40 (- ay1 3))
  409.   (setq p40 (list ax40 ay40))
  410.   (setq ax41 (+ ax2 (sqrt (- (* R R) 9))))
  411.   (setq ay41 ay39)
  412.   (setq p41 (list ax41 ay41))
  413.   (setq ax42 ax41)
  414.   (setq ay42 ay40)
  415.   (setq p42 (list ax42 ay42))
  416.   
  417.   ;绘制俯视图
  418.   (setvar "clayer" "cs_thick")
  419.   (setq ss1 (ssadd))
  420.   (vl-cmdf "line" p11 p12 "")
  421.   (setq ss1 (ssadd (entlast) ss1))
  422.   (vl-cmdf "line" p13 p34 "")
  423.   (setq ss1 (ssadd (entlast) ss1))
  424.   (vl-cmdf "line" p32 p34 "")
  425.   (setq ss1 (ssadd (entlast) ss1))
  426.   (vl-cmdf "line" p31 p32 "")
  427.   (setq ss1 (ssadd (entlast) ss1))
  428.   (vl-cmdf "line" p31 p33 "")
  429.   (setq ss1 (ssadd (entlast) ss1))
  430.   (vl-cmdf "line" p33 p14 "")
  431.   (setq ss1 (ssadd (entlast) ss1))
  432.   (vl-cmdf "line" p15 p17 "")
  433.   (setq ss1 (ssadd (entlast) ss1))
  434.   (vl-cmdf "line" p16 p18 "")
  435.   (setq ss1 (ssadd (entlast) ss1))
  436.   (vl-cmdf "line" p35 p37 "")
  437.   (setq ss1 (ssadd (entlast) ss1))
  438.   (vl-cmdf "line" p36 p38 "")
  439.   (setq ss1 (ssadd (entlast) ss1))
  440.   (vl-cmdf "line" p39 p41 "")
  441.   (setq ss1 (ssadd (entlast) ss1))
  442.   (vl-cmdf "line" p40 p42 "")
  443.   (setq ss1 (ssadd (entlast) ss1))
  444.   (vl-cmdf "arc" p11 "e" p15 "r" R1)
  445.   (setq ss1 (ssadd (entlast) ss1))
  446.   (vl-cmdf "arc" p17 "e" p13 "r" R1)
  447.   (setq ss1 (ssadd (entlast) ss1))
  448.   (vl-cmdf "arc" p14 "e" p18 "r" R1)
  449.   (setq ss1 (ssadd (entlast) ss1))
  450.   (vl-cmdf "arc" p16 "e" p12 "r" R1)
  451.   (setq ss1 (ssadd (entlast) ss1))
  452.   (vl-cmdf "circle" p1 "d" d)
  453.   (setq ss1 (ssadd (entlast) ss1))
  454.   (vl-cmdf "circle" p2 "d" d1)
  455.   (setq ss1 (ssadd (entlast) ss1))
  456.   (setvar "clayer" "cs_dashed")
  457.   (vl-cmdf "line" p7 p8 "")
  458.   (setq ss1 (ssadd (entlast) ss1))
  459.   (vl-cmdf "line" p9 p10 "")
  460.   (setq ss1 (ssadd (entlast) ss1))
  461.   (vl-cmdf "arc" p3 "e" p5 "r" R)
  462.   (setq ss1 (ssadd (entlast) ss1))
  463.   (vl-cmdf "arc" p6 "e" p4 "r" R)
  464.   (setq ss1 (ssadd (entlast) ss1))
  465.   (vl-cmdf "arc" p3 "e" p7 "r" R)
  466.   (setq ss1 (ssadd (entlast) ss1))
  467.   (vl-cmdf "arc" p8 "e" p4 "r" R)
  468.   (setq ss1 (ssadd (entlast) ss1))
  469.   (vl-cmdf "arc" p9 "e" p5 "r" R)
  470.   (setq ss1 (ssadd (entlast) ss1))
  471.   (vl-cmdf "arc" p6 "e" p10 "r" R)
  472.   (setq ss1 (ssadd (entlast) ss1))
  473.   (setvar "clayer" "cs_center")
  474.   (vl-cmdf "line" p19 p20 "")
  475.   (setq ss1 (ssadd (entlast) ss1))
  476.   (vl-cmdf "line" p21 p22 "")
  477.   (setq ss1 (ssadd (entlast) ss1))
  478.   (vl-cmdf "line" p23 p24 "")
  479.   (setq ss1 (ssadd (entlast) ss1))
  480.   (vl-cmdf "line" p25 p26 "")
  481.   (setq ss1 (ssadd (entlast) ss1))
  482.   (vl-cmdf "line" p27 p28 "")
  483.   (setq ss1 (ssadd (entlast) ss1))
  484.   (vl-cmdf "line" p29 p30 "")
  485.   (setq ss1 (ssadd (entlast) ss1))
  486.   
  487.   (setq blknam (strcat "dcsmb-z-f-" xh ))
  488.   (mblock_jx blknam ss1 p0)
  489.   (setq ss2 (entlast))
  490.   (vl-cmdf "erase" ss2 "")
  491.   (prompt "\n请输入插入点:")
  492.   (vl-cmdf "-insert" blknam  pause 1 1)
  493.   (prompt "\n请输入角度:")
  494.   (vl-cmdf pause)
  495.   (setq ss3 (entlast))
  496.   (if (/= blockyn "1")(vl-cmdf "explode" ss3))
  497.    
  498. );end_defun
  499. ;;;************************
  500. ;;; 5. 绘制正视图 函数     
  501. ;;;************************
  502. (defun dcsmb_draw2_jx( / sp ss1
  503.      ax0 ax1 ax2 ax3 ax4 ax5 ax6 ax7 ax8 ax9 ax10
  504.      ay0 ay1 ay2 ay3 ay4 ay5 ay6 ay7 ay8 ay9 ay10
  505.      p0 p1 p2 p3 p4 p5 p6 p7 p8 p9 p10 p11 p12 p13
  506.      p14 p15 p16 p17 p18 p19 p20 p21 p22 p23 p24 p25)
  507.   ;定义关键点
  508.   (setq sp (getvar "viewctr"))
  509.   (setq ax0 (car sp))
  510.   (setq ay0 (cadr sp))
  511.   (setq p0 (list ax0 ay0))
  512.   (setq ax1 (- ax0 (/ L1 2.0)))
  513.   (setq ay1 ay0)
  514.   (setq p1 (list ax1 ay1))
  515.   (setq ax2 (+ ax0 (/ L1 2.0)))
  516.   (setq ay2 ay0)
  517.   (setq p2 (list ax2 ay2))
  518.   (setq ax3 ax1)
  519.   (setq ay3 (+ ay0 H))
  520.   (setq p3 (list ax3 ay3))
  521.   (setq ax4 ax2)
  522.   (setq ay4 ay3)
  523.   (setq p4 (list ax4 ay4))
  524.   (setq ax5 ax0)
  525.   (setq ay5 (+ ay3 10.0))
  526.   (setq p5 (list ax5 ay5))
  527.   (setq ax6 ax0)
  528.   (setq ay6 (- ay0 10.0))
  529.   (setq p6 (list ax6 ay6))
  530.   (setq ax7 (- ax0 (/ C 2.0)))
  531.   (setq ay7 ay5)
  532.   (setq p7 (list ax7 ay7))
  533.   (setq ax8 (+ ax0 (/ C 2.0)))
  534.   (setq ay8 ay5)
  535.   (setq p8 (list ax8 ay8))
  536.   (setq ax9 ax7)
  537.   (setq ay9 ay6)
  538.   (setq p9 (list ax9 ay9))
  539.   (setq ax10 ax8)
  540.   (setq ay10 ay6)
  541.   (setq p10 (list ax10 ay10))
  542.   (setq ax11 (- (- ax0 (/ C 2)) (sqrt (- (/ (* d d) 4) 9))))
  543.   (setq ay11 ay3)
  544.   (setq p11 (list ax11 ay11))
  545.   (setq ax12 (+ (+ ax0 (/ C 2)) (sqrt (- (/ (* d1 d1) 4) 9))))
  546.   (setq ay12 ay3)
  547.   (setq p12 (list ax12 ay12))
  548.   (setq ax13 ax11)
  549.   (setq ay13 (- ay3 3.0))
  550.   (setq p13 (list ax13 ay13))
  551.   (setq ax14 ax12)
  552.   (setq ay14 ay13)
  553.   (setq p14 (list ax14 ay14))
  554.   (setq ax15 ax3)
  555.   (setq ay15 ay13)
  556.   (setq p15 (list ax15 ay15))
  557.   (setq ax16 ax4)
  558.   (setq ay16 ay15)
  559.   (setq p16 (list ax16 ay16))
  560.   (setq ax17 (- ax0 (/ c 2) (/ d 2)))
  561.   (setq ay17 ay0)
  562.   (setq p17 (list ax17 ay0))
  563.   (setq ax18 (+ (- ax0 (/ c 2)) (/ d 2)))
  564.   (setq ay18 ay0)
  565.   (setq p18 (list ax18 ay0))
  566.   (setq ax19 ax18)
  567.   (setq ay19 ay3)
  568.   (setq p19 (list ax19 ay3))
  569.   
  570.   (setq ax20 ax17)
  571.   (setq ay20 (- ay3 3))
  572.   (setq p20 (list ax20 ay20))
  573.   (setq ax21 (+ ax0 (/ c 2) (/ d1 2)))
  574.   (setq ay21 ay0)
  575.   (setq p21 (list ax21 ay21))
  576.   (setq ax22 (- (+ ax0 (/ c 2)) (/ d1 2)))
  577.   (setq ay22 ay0)
  578.   (setq p22 (list ax22 ay22))
  579.   (setq ax23 ax22)
  580.   (setq ay23 ay3)
  581.   (setq p23 (list ax23 ay3))
  582.   (setq ax24 ax21)
  583.   (setq ay24 ay20)
  584.   (setq p24 (list ax24 ay24))
  585.   
  586.   ;绘制主视图
  587.   (setvar "clayer" "cs_thick")
  588.   (setq ss1 (ssadd))
  589.   (vl-cmdf "line" p1 p2 "")
  590.   (setq ss1 (ssadd (entlast) ss1))
  591.   (vl-cmdf "line" p2 p4 "")
  592.   (setq ss1 (ssadd (entlast) ss1))
  593.   (vl-cmdf "line" p3 p4 "")
  594.   (setq ss1 (ssadd (entlast) ss1))
  595.   (vl-cmdf "line" p1 p3 "")
  596.   (setq ss1 (ssadd (entlast) ss1))
  597.   (vl-cmdf "line" p11 p13 "")
  598.   (setq ss1 (ssadd (entlast) ss1))
  599.   (vl-cmdf "line" p13 p15 "")
  600.   (setq ss1 (ssadd (entlast) ss1))
  601.   (vl-cmdf "line" p12 p14 "")
  602.   (setq ss1 (ssadd (entlast) ss1))
  603.   (vl-cmdf "line" p14 p16 "")
  604.   (setq ss1 (ssadd (entlast) ss1))
  605.   (vl-cmdf "line" p17 p20 "")
  606.   (setq ss1 (ssadd (entlast) ss1))
  607.   (vl-cmdf "line" p18 p19 "")
  608.   (setq ss1 (ssadd (entlast) ss1))
  609.   (vl-cmdf "line" p22 p23 "")
  610.   (setq ss1 (ssadd (entlast) ss1))
  611.   (vl-cmdf "line" p21 p24 "")
  612.   (setq ss1 (ssadd (entlast) ss1))
  613.   
  614.   (setvar "clayer" "cs_center")
  615.   (vl-cmdf "line" p5 p6 "")
  616.   (setq ss1 (ssadd (entlast) ss1))
  617.   (vl-cmdf "line" p7 p9 "")
  618.   (setq ss1 (ssadd (entlast) ss1))
  619.   (vl-cmdf "line" p8 p10 "")
  620.   (setq ss1 (ssadd (entlast) ss1))
  621.   (setq blknam (strcat "hdzsmb-z-z-" xh ))
  622.   (mblock_jx blknam ss1 p0)
  623.   (setq ss2 (entlast))
  624.   (vl-cmdf "erase" ss2 "")
  625.   (prompt "\n请输入插入点:")
  626.   (vl-cmdf "-insert" blknam  pause 1 1)
  627.   (prompt "\n请输入角度:")
  628.   (vl-cmdf pause)
  629.   (setq ss3 (entlast))
  630.   (if (/= blockyn "1")(vl-cmdf "explode" ss3))
  631.    
  632. );end_defun
  633. ;;;*************************
  634. ;;; 6. 制作有/无名块 函数   
  635. ;;;*************************
  636. (defun mblock_jx (BloName SS1 insPt / count entlist ent Blk retBlk)
  637. (if (= BloName "")
  638.    (entmake (list (cons 0 "BLOCK") (cons 2 "*U") (cons 70 1) (cons 10 insPt)));无名块.
  639.   (entmake (list (cons 0 "BLOCK") (cons 2 BloName) (cons 70 0) (cons 10 insPt)));有名块.
  640. );endif
  641.   (setq count 0)
  642.   (repeat (sslength SS1)
  643.     (setq entlist (entget (setq ent (ssname SS1  count))))
  644.     (setq count (1+ count))
  645.     (entmake entlist)
  646.   );end_repeat
  647.   (setq count 0)
  648.   (repeat (sslength SS1)
  649.     (setq ent (ssname SS1 count))
  650.     (setq count (1+ count))
  651.     (entdel ent)
  652.   );end_repeat
  653. (setq Blk (entmake '((0 . "ENDBLK"))))
  654. (if (princ Blk)
  655.   (entmake (list (cons 0  "INSERT") (cons 2 Blk) (cons 10 insPt)))
  656. );end_if
  657.   (setq retBlk Blk)
  658. );end_defun
  659. ;结束程序系统还原++++++++++++++++++++++++++++++++++++++++++++
  660. (defun revert_jx()
  661.   (setvar "clayer" "cs_thick")
  662.   (setvar "osmode" os)
  663.   (princ)
  664.     )
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2025-6-17 23:18 , Processed in 0.172404 second(s), 19 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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