设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [LISP程序]：表格绘制程序
返回列表 发新帖
查看: 1605|回复: 5

[LISP程序]：表格绘制程序

[复制链接]
mmmm
发表于 2003-6-11 15:30:35 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要 登录 才可以下载或查看，没有账号？立即注册

×
附件是原始文件

  3. ;|
  4. 这个程序有点意思，想法挺好。原来的对话框布局不太美观，调整了一下。顺手也给汉化了。
  5. 程序会新建图层TABLE，颜色红色，表格内文本高度根据当前尺寸标注的相关变量
  6. 自动适应。最终的表格宽度会自动根据单元字符长度自适应。不错。
  7. 唯一的遗憾是行列最多为10，并且输入时不时很方便（但很直观，新手应该喜欢 :)）。
  8. |;
  9. (Defun C:TABLE (/              CR            DLG_CLOSE          DLG_HEADER
  10.                 DLG_DIALOG    DLG_ITEM            DLG_PROTO          DLG_ATT
  11.                 SYMTOS              DCL_TEMP            DCL_MATRIX          DCL_MATRIX_HED
  12.                 SET_COL              GET_COL            SET_ROW          GET_ROW
  13.                 GET_QTY              CHECK_NEXT    SET_NEXT_MATRIX_ITEM
  14.                 TOGG_ASSOC    OL            OS                  OC
  15.                 DLG_MAIN      DELETE_TEMP_DCL                  DLG_MATRIX
  16.                 DLG_MATRIX_HEAD                    GET_MATRIX
  17.                 GET_MATRIX_HEAD                    DRAW_TABLE
  18.                 DRAW_TABLE_HEAD                    *TABLEID*          FD
  19.                 ROW_NDX              COL_NDX            COL_QTY          COL_NUM
  20.                 COL_INPUT     NO_OF_COLS    ROW_QTY          ROW_NUM
  21.                 ROW_INPUT     NO_OF_ROWS    FLAG          NEXT_MATRIX
  22.                 TOG_VALUE     INCL            DCL_ID          TITLE
  23.                 DS              OSMODE            CECOLOR          CLAYER
  24.                 SCALE              SIZE            HALFSIZE          TITLESIZE
  25.                 SP              CNT            TOTAL_WIDTH          TOTAL_HEIGHT
  26.                )
  27. ;;;;;Main dialog control functions;;;;
  28.   (Defun CR () (princ "\n" FD))
  29.   (Defun DLG_CLOSE () (princ "}" FD) (CR))
  30.   (Defun DLG_HEADER (AUDIT)
  31.     (princ "dcl_settings : default_dcl_settings {" FD)
  32.     (CR)
  33.     (princ (strcat " audit_level = " (itoa AUDIT) "; }") FD)
  34.     (CR)
  35.   ) ;_ end of Defun
  36.   (Defun DLG_DIALOG (NAME)
  37.     (princ (strcat NAME " : dialog {") FD)
  38.     (CR)
  39.   )
  40.   (Defun DLG_ITEM (ITEM)
  41.     (princ (strcat ": " ITEM "{") FD)
  42.     (CR)
  43.   )
  44.   (Defun DLG_PROTO (type) (princ (strcat type ";") FD) (CR))
  45.   (Defun DLG_ATT (ATT VAL)
  46.     (cond
  47.       ((= (type VAL) 'INT)
  48.        (princ (strcat ATT "=" (itoa VAL) ";") FD)
  49.        (CR)
  50.       )
  51.       ((= (type VAL) 'REAL)
  52.        (princ (strcat ATT "=" (rtos VAL) ";") FD)
  53.        (CR)
  54.       )
  55.       ((= (type VAL) 'STR)
  56.        (princ (strcat ATT "="" VAL "";") FD)
  57.        (CR)
  58.       )
  59.       ((= (type VAL) 'SYM)
  60.        (princ (strcat ATT "=" (SYMTOS VAL) ";") FD)
  61.        (CR)
  62.       )
  63.     ) ;_ end of cond
  64.   ) ;_ end of Defun
  65.   (Defun SYMTOS        (SYM / FD)
  66.     (setq FD (open "symtos.txt" "w"))
  67.     (princ SYM FD)
  68.     (close FD)
  69.     (setq
  70.       FD  (open "symtos.txt" "r")
  71.       SYM (strcase (read-line FD) t)
  72.     ) ;_ end of setq
  73.     (close FD)
  74.     SYM
  75.   ) ;_ end of Defun
  76.   (Defun DCL_TEMP (/ FD)
  77.     (setq FD (open "temp.dcl" "w"))
  78.     (DLG_HEADER 0)
  79. ;;;Define Main Dialog;;;
  80.     (DLG_DIALOG "dlg_main")
  81.     (DLG_ATT "label" "表格数据设定")
  82.     (DLG_ITEM "boxed_column")
  83.     (DLG_ATT "label" "行列数目设定")
  84.     (DLG_ITEM "popup_list")
  85.     (DLG_ATT "key" "col_qty")
  86.     (DLG_ATT "label" "请选择行数:")
  87.     (DLG_CLOSE)
  88.     (DLG_ITEM "popup_list")
  89.     (DLG_ATT "key" "row_qty")
  90.     (DLG_ATT "label" "请选择列数:")
  91.     (DLG_CLOSE)
  92.     (DLG_CLOSE)
  93.     (DLG_ITEM "toggle")
  94.     (DLG_ATT "label" "定义标题字符串")
  95.     (DLG_ATT "key" "togg")
  96.     (DLG_CLOSE)
  97.     (DLG_ITEM "button")
  98.     (DLG_ATT "key" "get_qty")
  99.     (DLG_ATT "label" "表格数据输入...")
  100.     (DLG_CLOSE)
  101.     (DLG_ITEM "button")
  102.     (DLG_ATT "key" "cancel")
  103.     (DLG_ATT "is_cancel" 'TRUE)
  104.     (DLG_ATT "label" "退出")
  105.     (DLG_CLOSE)
  106.     (DLG_CLOSE)
  107.     (close FD)
  108.     "temp.dcl"
  109.   ) ;_ end of Defun
  110.   (Defun DCL_MATRIX (/ FD)
  111.     (setq FD (open "temp.dcl" "w"))
  112.     (DLG_HEADER 0)
  113. ;;;define Table matrix dialog;;;
  114.     (DLG_DIALOG "dlg_matrix")
  115.     (DLG_ATT "label" "表格矩阵数据输入 (无标题文本)")
  116.     (DLG_ITEM "boxed_column")
  117.     (DLG_ATT "label" "表格矩阵数据输入 (无标题文本)")
  118.     (setq ROW_NDX 1)
  119.     (repeat NO_OF_ROWS
  120.       (DLG_ITEM "row")
  121.       (setq COL_NDX 1)
  122.       (repeat NO_OF_COLS
  123.         (DLG_ITEM "edit_box")
  124.         (DLG_ATT
  125.           "key"
  126.           (strcat "row" (itoa ROW_NDX) "col" (itoa COL_NDX))
  127.         ) ;_ end of dlg_att
  128.         (DLG_ATT "edit_width" 7)
  129.         (DLG_ATT "edit_limit" 20)
  130.         (DLG_CLOSE)
  131.         (setq COL_NDX (1+ COL_NDX))
  132.       ) ;_ end of repeat
  133.       (DLG_CLOSE)
  134.       (setq ROW_NDX (1+ ROW_NDX))
  135.     ) ;_ end of repeat
  136.     (DLG_CLOSE)
  137.     (DLG_ITEM "row")
  138.     (DLG_ITEM "button")
  139.     (DLG_ATT "key" "do_Table")
  140.     (DLG_ATT "label" "插入表格")
  141.     (DLG_CLOSE)
  142.     (DLG_ITEM "button")
  143.     (DLG_ATT "key" "cancel")
  144.     (DLG_ATT "is_cancel" 'TRUE)
  145.     (DLG_ATT "label" "退出")
  146.     (DLG_CLOSE)
  147.     (DLG_CLOSE)
  148.     (DLG_CLOSE)
  149.     (close FD)
  150.     "temp.dcl"
  151.   ) ;_ end of Defun
  152.   (Defun DCL_MATRIX_HEAD (/ FD)
  153.     (setq FD (open "temp.dcl" "w"))
  154.     (DLG_HEADER 0)
  155. ;;;define Table Matrix_head dialog;;;
  156.     (DLG_DIALOG "dlg_matrix_head")
  157.     (DLG_ATT "label" "表格矩阵数据输入 (含标题文本)")
  158.     (DLG_ITEM "edit_box")
  159.     (DLG_ATT "key" "title")
  160.     (DLG_ATT "label" "表格标题:")
  161.     (DLG_CLOSE)
  162.     (DLG_ITEM "boxed_column")
  163.     (DLG_ATT "label" "表格矩阵数据输入 (含标题文本)")
  164.     (setq ROW_NDX 1)
  165.     (repeat NO_OF_ROWS
  166.       (DLG_ITEM "row")
  167.       (setq COL_NDX 1)
  168.       (repeat NO_OF_COLS
  169.         (DLG_ITEM "edit_box")
  170.         (DLG_ATT
  171.           "key"
  172.           (strcat "row" (itoa ROW_NDX) "col" (itoa COL_NDX))
  173.         ) ;_ end of dlg_att
  174.         (DLG_ATT "edit_width" 7)
  175.         (DLG_ATT "edit_limit" 20)
  176.         (DLG_CLOSE)
  177.         (setq COL_NDX (1+ COL_NDX))
  178.       ) ;_ end of repeat
  179.       (DLG_CLOSE)
  180.       (setq ROW_NDX (1+ ROW_NDX))
  181.     ) ;_ end of repeat
  182.     (DLG_CLOSE)
  183.     (DLG_ITEM "row")
  184.     (DLG_ITEM "button")
  185.     (DLG_ATT "key" "do_Table")
  186.     (DLG_ATT "label" "插入表格")
  187.     (DLG_CLOSE)
  188.     (DLG_ITEM "button")
  189.     (DLG_ATT "key" "cancel")
  190.     (DLG_ATT "is_cancel" 'TRUE)
  191.     (DLG_ATT "label" "退出")
  192.     (DLG_CLOSE)
  193.     (DLG_CLOSE)
  194.     (DLG_CLOSE)
  195.     (close FD)
  196.     "temp.dcl"
  197.   )
  198. ;;;********************SET UP COLUMN QUANTITY POPUP LIST********************
  199.   (Defun SET_COL ()
  200.     (setq COL_QTY (list "2" "3" "4" "5" "6" "7" "8" "9" "10"))
  201.     (start_list "col_qty")
  202.     (mapcar 'add_list COL_QTY)
  203.     (end_list)
  204.     (if        (not COL_NUM)
  205.       (set_tile "col_qty" "0")
  206.       (set_tile "col_qty" (itoa COL_NUM))
  207.     ) ;_ end of if
  208.   )
  209. ;;;********************GET COLUMN QUANTITY POPUP LIST***********************
  210.   (Defun GET_COL ()
  211.     (setq COL_NUM (atoi (get_tile "col_qty")))
  212.     (setq COL_INPUT (nth COL_NUM COL_QTY))
  213.     (setq NO_OF_COLS (atoi COL_INPUT))
  214.   )
  215. ;;;********************SET UP ROW QUANTITY POPUP LIST********************
  216.   (Defun SET_ROW ()
  217.     (setq ROW_QTY (list "2" "3" "4" "5" "6" "7" "8" "9" "10"))
  218.     (start_list "row_qty")
  219.     (mapcar 'add_list ROW_QTY)
  220.     (end_list)
  221.     (if        (not ROW_NUM)
  222.       (set_tile "row_qty" "0")
  223.       (set_tile "row_qty" (itoa ROW_NUM))
  224.     ) ;_ end of if
  225.   )
  226. ;;;********************GET ROW QUANTITY POPUP LIST***********************
  227.   (Defun GET_ROW ()
  228.     (setq ROW_NUM (atoi (get_tile "row_qty")))
  229.     (setq ROW_INPUT (nth ROW_NUM ROW_QTY))
  230.     (setq NO_OF_ROWS (atoi ROW_INPUT))
  231.   )
  232. ;;;*************GET QUANTITY OF COLUMNS & ROWS FROM POPUP LISTS**********
  233.   (Defun GET_QTY () (GET_COL) (GET_ROW) (setq FLAG 2))
  234. ;;; Utility function to aid in allowing user to input by Columns
  235.   (Defun CHECK_NEXT (REASON KEY LST)
  236.     (if        (= REASON 1)
  237.       (mode_tile (cdr (assoc KEY (eval (read "next_matrix")))) 2)
  238.     ) ;_ end of if
  239.   )
  240. ;;;**SET UP A LIST TO ALLOW THE RETURN KEY TO BE USED (COLUMN INPUT) AS WELL AS TAB KEY FOR (ROW INPUT)**
  241.   (Defun SET_NEXT_MATRIX_ITEM ()
  242.     (setq COL_NDX 1)
  243.     (repeat NO_OF_COLS
  244.       (setq ROW_NDX 1)
  245.       (setq
  246.         NEXT_MATRIX
  247.          (append
  248.            NEXT_MATRIX
  249.            (list
  250.              (cons
  251.                (strcat
  252.                  "row"
  253.                  (itoa ROW_NDX)
  254.                  "col"
  255.                  (itoa COL_NDX)
  256.                ) ;_ end of strcat
  257.                (strcat
  258.                  "row"
  259.                  (itoa (1+ ROW_NDX))
  260.                  "col"
  261.                  (itoa COL_NDX)
  262.                ) ;_ end of strcat
  263.              ) ;_ end of cons
  264.            ) ;_ end of list
  265.          ) ;_ end of append
  266.       ) ;_ end of setq
  267.       (while (< ROW_NDX NO_OF_ROWS)
  268.         (setq ROW_NDX (1+ ROW_NDX))
  269.         (setq
  270.           NEXT_MATRIX
  271.            (append
  272.              NEXT_MATRIX
  273.              (list
  274.                (cons
  275.                  (strcat
  276.                    "row"
  277.                    (itoa ROW_NDX)
  278.                    "col"
  279.                    (itoa COL_NDX)
  280.                  ) ;_ end of strcat
  281.                  (strcat
  282.                    "row"
  283.                    (itoa (1+ ROW_NDX))
  284.                    "col"
  285.                    (itoa COL_NDX)
  286.                  ) ;_ end of strcat
  287.                ) ;_ end of cons
  288.              ) ;_ end of list
  289.            ) ;_ end of append
  290.         ) ;_ end of setq
  291.       ) ;_ end of while
  292.       (setq COL_NDX (1+ COL_NDX))
  293.     ) ;_ end of repeat
  294.   ) ;_ end of Defun
  295.   (Defun TOG_ASSOC ()
  296.     (if        (= TOG_VALUE "1")
  297.       (setq INCL "yes")
  298.     ) ;_ end of if
  299.     (if        (= TOG_VALUE "0")
  300.       (setq INCL "no")
  301.     ) ;_ end of if
  302.   ) ;_ end of Defun
  303. ;;;;;MAIN DIALOG CONTROL FUNCTIONS;;;;
  304. ;;; Loads the Main Dialog and Removes it when selections (OR) ok/cancel are pushed ;;;
  305.   (Defun DLG_MAIN (/ FLAG)
  306.     (if        (< (setq DCL_ID (load_dialog "temp.dcl")) 0)
  307.       (exit)
  308.     ) ;_ end of if
  309.     (close (open "temp.dcl" "w"))
  310.     (if        (not (new_dialog "dlg_main" *TABLEID*))
  311.       (exit)
  312.     ) ;_ end of if
  313.     (SET_COL)
  314.     (SET_ROW)
  315.     (action_tile "togg" "(setq tog_value $value)(tog_assoc)")
  316.     (action_tile "col_qty" "(get_col)")
  317.     (action_tile "row_qty" "(get_row)")
  318.     (action_tile
  319.       "get_qty"
  320.       "(tog_assoc)(get_qty)(done_dialog 1)"
  321.     )
  322.     (action_tile "cancel" "(done_dialog 0)")
  323.     (start_dialog)
  324.     (if        (= FLAG 2)
  325.       (DELETE_TEMP_DCL)
  326.     ) ;_ end of if
  327.     (setq FD (open "symtos.txt" "w"))
  328.     (princ "" FD)
  329.     (close FD)
  330.     (princ)
  331.   ) ;_ end of Defun
  332.   (Defun DELETE_TEMP_DCL (/ *TABLEID*)        ;delete
  333.     (if        (not *TABLEID*)
  334. ;;; first time thru
  335.       (progn
  336.         (if (= INCL "no")
  337.           (DCL_MATRIX)
  338.         ) ;_ end of if
  339.         (if (= INCL "yes")
  340.           (DCL_MATRIX_HEAD)
  341.         ) ;_ end of if
  342.         (if (< (setq *TABLEID* (load_dialog "temp.dcl")) 0)
  343.           (*ERROR* "对话框输入数据错误")
  344.         ) ;_ end of if
  345.         (if (= INCL "no")
  346.           (DLG_MATRIX)
  347.         ) ;_ end of if
  348.         (if (= INCL "yes")
  349.           (DLG_MATRIX_HEAD)
  350.         ) ;_ end of if
  351.       ) ;_ end of progn
  352.     ) ;_ end of if
  353.   ) ;_ end of Defun
  354.   (Defun DLG_MATRIX (/ FLAG)
  355.     (if        (< (setq DCL_ID (load_dialog "temp.dcl")) 0)
  356.       (exit)
  357.     ) ;_ end of if
  358.     (close (open "temp.dcl" "w"))
  359.     (if        (not (new_dialog "dlg_matrix" *TABLEID*))
  360.       (exit)
  361.     ) ;_ end of if
  362.     (SET_NEXT_MATRIX_ITEM)
  363.     (foreach
  364.               A
  365.                NEXT_MATRIX
  366.       (action_tile (car A) "(check_next $reason $key 0)")
  367.     ) ;_ end of foreach
  368.     (action_tile "do_Table" "(get_matrix) (done_dialog 1)")
  369.     (action_tile "cancel" "(done_dialog 0)")
  370.     (start_dialog)
  371.     (if        (= FLAG 1)
  372.       (DRAW_TABLE)
  373.     ) ;_ end of if
  374.     (unload_dialog DCL_ID)
  375.   ) ;_ end of Defun
  376.   (Defun
  377.             DLG_MATRIX_HEAD
  378.                            (/ FLAG)
  379.     (if        (< (setq DCL_ID (load_dialog "temp.dcl")) 0)
  380.       (exit)
  381.     ) ;_ end of if
  382.     (close (open "temp.dcl" "w"))
  383.     (if        (not (new_dialog "dlg_matrix_head" *TABLEID*))
  384.       (exit)
  385.     ) ;_ end of if
  386.     (SET_NEXT_MATRIX_ITEM)
  387.     (foreach A NEXT_MATRIX
  388.       (action_tile (car A) "(check_next $reason $key 0)")
  389.     ) ;_ end of foreach
  390.     (action_tile "do_Table" "(get_matrix_head) (done_dialog 1)")
  391.     (action_tile "cancel" "(done_dialog 0)")
  392.     (start_dialog)
  393.     (if        (= FLAG 1)
  394.       (DRAW_TABLE_HEAD)
  395.     ) ;_ end of if
  396.     (unload_dialog DCL_ID)
  397.   ) ;_ end of Defun
  398.   (Defun GET_MATRIX ()
  399.     (terpri)
  400.     (princ "读取矩阵输入数据...")
  401.     (setq COL_NDX 1)
  402.     (setq ROW_NDX 1)
  403.     (repeat NO_OF_ROWS
  404.       (setq COL_NDX 1)
  405.       (repeat NO_OF_COLS
  406.         (set
  407.           (read (strcat "row" (itoa ROW_NDX) "col" (itoa COL_NDX)))
  408.           (get_tile (strcat "row" (itoa ROW_NDX) "col" (itoa COL_NDX))
  409.           )
  410.         ) ;_ end of set
  411.         (setq COL_NDX (1+ COL_NDX))
  412.       ) ;_ end of repeat
  413.       (setq ROW_NDX (1+ ROW_NDX))
  414.     ) ;_ end of repeat
  415.     (setq FLAG 1)
  416.   ) ;_ end of Defun
  417.   (Defun GET_MATRIX_HEAD ()
  418.     (terpri)
  419.     (princ "读取矩阵输入数据...")
  420.     (setq TITLE (get_tile "title"))
  421.     (setq COL_NDX 1)
  422.     (setq ROW_NDX 1)
  423.     (repeat NO_OF_ROWS
  424.       (setq COL_NDX 1)
  425.       (repeat NO_OF_COLS
  426.         (set
  427.           (read (strcat "row" (itoa ROW_NDX) "col" (itoa COL_NDX)))
  428.           (get_tile (strcat "row" (itoa ROW_NDX) "col" (itoa COL_NDX))
  429.           )
  430.         ) ;_ end of set
  431.         (setq COL_NDX (1+ COL_NDX))
  432.       ) ;_ end of repeat
  433.       (setq ROW_NDX (1+ ROW_NDX))
  434.     ) ;_ end of repeat
  435.     (setq FLAG 1)
  436.   ) ;_ end of Defun
  437.   (Defun DRAW_TABLE ()
  438.     (setvar "cmdecho" 0)
  439.     (setq DS          (getvar "dimscale")
  440.           OSMODE
  441.                   (getvar "osmode")
  442.           CECOLOR
  443.                   (getvar "cecolor")
  444.           CLAYER
  445.                   (getvar "clayer")
  446.           SCALE
  447.                   (getvar "dimscale")
  448.     ) ;_ end of setq
  449.     (if        (= (tblsearch "layer" "TABLE") NIL)
  450.       (command "layer" "make" "TABLE" "color" "red" "" "set" "TABLE" "")
  451.     ) ;_ end of if
  452.     (command "layer" "set" "TABLE" "")
  453.     (if        (= (tblsearch "style" "romans") NIL)
  454.       (command "style" "romans" "romans.shx" "" "" "" "" "" "")
  455.     ) ;_ end of if
  456.     (if        (= (tblsearch "style" "romand") NIL)
  457.       (command "style" "romand" "romand.shx" "" "" "" "" "" "")
  458.     ) ;_ end of if
  459.     (setq SIZE (* (getvar "dimscale") (getvar "dimtxt")))
  460.     (setq HALFSIZE (* SIZE 0.5))
  461.     (setq TITLESIZE (* SIZE 1.5))
  462.     (setq SP (getpoint "\n 请点取表格左上角位置: "))
  463.     (setvar "osmode" 0)
  464.     (setq TABLE_WIDTH 0)
  465.     (setq COL_NDX 1)
  466.     (repeat NO_OF_COLS
  467.       (setq ROW_NDX 1)
  468.       (setq COL_WIDTH 0)
  469.       (while
  470.         (/= (eval
  471.               (read (strcat "row" (itoa ROW_NDX) "col" (itoa COL_NDX)))
  472.             ) ;_ end of eval
  473.             NIL
  474.         ) ;_ end of /=
  475.          (progn
  476.            (setq
  477.              ENTRY_WIDTH
  478.               (strlen
  479.                 (eval
  480.                   (read
  481.                     (strcat
  482.                       "row"
  483.                       (itoa ROW_NDX)
  484.                       "col"
  485.                       (itoa COL_NDX)
  486.                     ) ;_ end of strcat
  487.                   ) ;_ end of read
  488.                 ) ;_ end of eval
  489.               ) ;_ end of strlen
  490.            ) ;_ end of setq
  491.            (if (> ENTRY_WIDTH COL_WIDTH)
  492.              (setq COL_WIDTH ENTRY_WIDTH)
  493.            ) ;_ end of if
  494.            (setq ROW_NDX (1+ ROW_NDX))
  495.          ) ;_ end of progn
  496.       ) ;_ end of while
  497.       (setq COL_WIDTH (+ COL_WIDTH 1.0))
  498.       (set (read (strcat "column" (itoa COL_NDX))) COL_WIDTH)
  499.       (setq TABLE_WIDTH (+ TABLE_WIDTH COL_WIDTH))
  500.       (setq COL_NDX (1+ COL_NDX))
  501.     ) ;_ end of repeat
  502.     (setq TOTAL_WIDTH (* SIZE TABLE_WIDTH))
  503.     (setq TOTAL_HEIGHT (* (* SIZE 2.0) NO_OF_ROWS))
  504.     (setq PT1 (list (+ (car SP) TOTAL_WIDTH) (cadr SP) 0.0))
  505.     (setq PT2 (list (+ (car SP) TOTAL_WIDTH)
  506.                     (- (cadr SP) TOTAL_HEIGHT)
  507.                     0.0
  508.               )
  509.     ) ;_ end of setq
  510.     (setq PT3 (list (car SP) (- (cadr SP) TOTAL_HEIGHT) 0.0))
  511.     (setq TEMP (getvar "plinewid"))
  512.     (setvar "plinewid" 0.015)
  513.     (command "pline" SP PT1 PT2 PT3 "close")
  514. ;;;;Draw horizontal lines in Table;;;;
  515.     (setq ROW_NDX 1)
  516.     (repeat (- NO_OF_ROWS 1)
  517.       (setq
  518.         LP (list (car SP) (- (cadr SP) (* (* SIZE 2.0) ROW_NDX)) 0.0)
  519.       ) ;_ end of setq
  520.       (setq
  521.         RP (list (car PT1) (- (cadr SP) (* (* SIZE 2.0) ROW_NDX)) 0.0)
  522.       ) ;_ end of setq
  523.       (command "line" LP RP "")
  524.       (setq ROW_NDX (1+ ROW_NDX))
  525.     ) ;_ end of repeat
  526. ;;;;Draw vertical lines in Table;;;;
  527.     (setq NDX 1)
  528.     (repeat (- NO_OF_COLS 1)
  529.       (if (= NDX 1)
  530.         (setq TP (list (+ (car SP) (* COLUMN1 SIZE)) (cadr SP) 0.0))
  531.         (setq
  532.           TP (list
  533.                (+ (car (getvar "lastpoint"))
  534.                   (* (eval (read (strcat "column" (itoa NDX)))) SIZE)
  535.                ) ;_ end of +
  536.                (cadr SP)
  537.                0.0
  538.              ) ;_ end of list
  539.         ) ;_ end of setq
  540.       ) ;_ end of if
  541.       (if (= NDX 1)
  542.         (setq BP (list (+ (car SP) (* COLUMN1 SIZE)) (cadr PT3) 0.0))
  543.         (setq
  544.           BP (list
  545.                (+ (car (getvar "lastpoint"))
  546.                   (* (eval (read (strcat "column" (itoa NDX)))) SIZE)
  547.                ) ;_ end of +
  548.                (cadr PT3)
  549.                0.0
  550.              ) ;_ end of list
  551.         ) ;_ end of setq
  552.       ) ;_ end of if
  553.       (command "line" TP BP "")
  554.       (setq NDX (1+ NDX))
  555.     ) ;_ end of repeat
  556.     (setvar "plinewid" TEMP)
  557.     (setvar "textstyle" "romans")
  558. ;;;;Place matrix text;;;;
  559.     (setq COL_NDX 1)
  560.     (setq ROW_NDX 1)
  561.     (repeat NO_OF_COLS
  562.       (if (= COL_NDX 1)
  563.         (setq
  564.           HP (+        (car SP)
  565.                 (* (eval (read (strcat "column" (itoa COL_NDX))))
  566.                    HALFSIZE
  567.                 ) ;_ end of *
  568.              ) ;_ end of +
  569.         ) ;_ end of setq
  570.         (setq
  571.           HP
  572.            (+
  573.              HP
  574.              (+        (* (eval (read (strcat "column" (itoa (- COL_NDX 1)))))
  575.                    HALFSIZE
  576.                 ) ;_ end of *
  577.                 (* (eval (read (strcat "column" (itoa COL_NDX))))
  578.                    HALFSIZE
  579.                 ) ;_ end of *
  580.              ) ;_ end of +
  581.            ) ;_ end of +
  582.         ) ;_ end of setq
  583.       ) ;_ end of if
  584.       (setq ROW_NDX 1)
  585.       (repeat NO_OF_ROWS
  586.         (if (= ROW_NDX 1)
  587.           (setq VP (- (cadr SP) (* SIZE 1)))
  588.           (setq VP (- VP (* SIZE 2)))
  589.         ) ;_ end of if
  590.         (setq LOC (list HP VP 0.0))
  591.         (command
  592.           "text"
  593.           "j"
  594.           "mc"
  595.           LOC
  596.           SIZE
  597.           "0"
  598.           (eval
  599.             (read (strcat "row" (itoa ROW_NDX) "col" (itoa COL_NDX)))
  600.           ) ;_ end of eval
  601.         ) ;_ end of command
  602.         (setq ROW_NDX (1+ ROW_NDX))
  603.       ) ;_ end of repeat
  604.       (setq COL_NDX (1+ COL_NDX))
  605.     ) ;_ end of repeat
  606. ;;;;Delete Matrix Variables
  607.     (setq CNT 1)
  608.     (while (<= CNT NDX)
  609.       (set (read (strcat "column" (itoa CNT))) NIL)
  610.       (setq CNT (1+ CNT))
  611.     ) ;_ end of while
  612.     (setq COL_NDX 1)
  613.     (setq ROW_NDX 1)
  614.     (repeat NO_OF_COLS
  615.       (if (= COL_NDX 1)
  616.         (set (read (strcat "column" (itoa COL_NDX))) NIL)
  617.         (set (read (strcat "column" (itoa (- COL_NDX 1)))) NIL)
  618.       ) ;_ end of if
  619.       (setq ROW_NDX 1)
  620.       (repeat NO_OF_ROWS
  621.         (set
  622.           (read (strcat "row" (itoa ROW_NDX) "col" (itoa COL_NDX)))
  623.           NIL
  624.         ) ;_ end of set
  625.         (setq ROW_NDX (1+ ROW_NDX))
  626.       ) ;_ end of repeat
  627.       (setq COL_NDX (1+ COL_NDX))
  628.     ) ;_ end of repeat
  629.     (setvar "osmode" OSMODE)
  630.     (setvar "cecolor" CECOLOR)
  631.     (setvar "clayer" CLAYER)
  632.   ) ;_ end of Defun
  633.   (Defun DRAW_TABLE_HEAD ()
  634.     (setvar "cmdecho" 0)
  635.     (setq DS          (getvar "dimscale")
  636.           OSMODE
  637.                   (getvar "osmode")
  638.           CECOLOR
  639.                   (getvar "cecolor")
  640.           CLAYER
  641.                   (getvar "clayer")
  642.           SCALE
  643.                   (getvar "dimscale")
  644.     ) ;_ end of setq
  645.     (if        (= (tblsearch "layer" "TABLE") NIL)
  646.       (command "layer" "make" "TABLE" "color" "red" "" "set" "TABLE" "")
  647.     ) ;_ end of if
  648.     (command "layer" "set" "TABLE" "")
  649.     (if        (= (tblsearch "style" "romans") NIL)
  650.       (command "style" "romans" "romans.shx" "" "" "" "" "" "")
  651.     ) ;_ end of if
  652.     (if        (= (tblsearch "style" "romand") NIL)
  653.       (command "style" "romand" "romand.shx" "" "" "" "" "" "")
  654.     ) ;_ end of if
  655.     (setq SIZE (* (getvar "dimscale") (getvar "dimtxt")))
  656.     (setq HALFSIZE (* SIZE 0.5))
  657.     (setq TITLESIZE (* SIZE 1.5))
  658.     (setq SP (getpoint "\n 请点取表格左上角位置: "))
  659.     (setvar "osmode" 0)
  660.     (setq TITLE_WIDTH (strlen TITLE))
  661.     (setq TABLE_WIDTH 0)
  662.     (setq COL_NDX 1)
  663.     (repeat NO_OF_COLS
  664.       (setq ROW_NDX 1)
  665.       (setq COL_WIDTH 0)
  666.       (while
  667.         (/= (eval
  668.               (read (strcat "row" (itoa ROW_NDX) "col" (itoa COL_NDX)))
  669.             ) ;_ end of eval
  670.             NIL
  671.         ) ;_ end of /=
  672.          (progn
  673.            (setq
  674.              ENTRY_WIDTH
  675.               (strlen
  676.                 (eval
  677.                   (read
  678.                     (strcat
  679.                       "row"
  680.                       (itoa ROW_NDX)
  681.                       "col"
  682.                       (itoa COL_NDX)
  683.                     ) ;_ end of strcat
  684.                   ) ;_ end of read
  685.                 ) ;_ end of eval
  686.               ) ;_ end of strlen
  687.            ) ;_ end of setq
  688.            (if (> ENTRY_WIDTH COL_WIDTH)
  689.              (setq COL_WIDTH ENTRY_WIDTH)
  690.            ) ;_ end of if
  691.            (setq ROW_NDX (1+ ROW_NDX))
  692.          ) ;_ end of progn
  693.       ) ;_ end of while
  694.       (setq COL_WIDTH (+ COL_WIDTH 1.0))
  695.       (set (read (strcat "column" (itoa COL_NDX))) COL_WIDTH)
  696.       (setq TABLE_WIDTH (+ TABLE_WIDTH COL_WIDTH))
  697.       (setq COL_NDX (1+ COL_NDX))
  698.     ) ;_ end of repeat
  699. ;;;Determine which is Greater (The Title Width) or (The Sum of all the Column Widths);;;
  700.     (setq OVERAGE (/ (- (* TITLE_WIDTH 1.5) TABLE_WIDTH) NO_OF_COLS))
  701.     (if        (or (= OVERAGE 0) (> OVERAGE 0))
  702.       (progn
  703.         (setq TABLE_WIDTH 0)
  704.         (setq OVERAGE (1+ (fix OVERAGE)))
  705.         (setq COL_NDX 1)
  706.         (repeat        NO_OF_COLS
  707.           (while
  708.             (/= (eval (read (strcat "column" (itoa COL_NDX)))) NIL)
  709.              (progn
  710.                (set
  711.                  (read (strcat "column" (itoa COL_NDX)))
  712.                  (+ (eval (read (strcat "column" (itoa COL_NDX))))
  713.                     OVERAGE
  714.                  ) ;_ end of +
  715.                ) ;_ end of set
  716.                (setq
  717.                  COL_WIDTH
  718.                   (eval (read (strcat "column" (itoa COL_NDX))))
  719.                ) ;_ end of setq
  720.                (setq TABLE_WIDTH (+ TABLE_WIDTH COL_WIDTH))
  721.                (setq COL_NDX (1+ COL_NDX))
  722.              ) ;_ end of progn
  723.           ) ;_ end of while
  724.         ) ;_ end of repeat
  725.       ) ;_ end of progn
  726.     ) ;_ end of if
  727.     (setq TOTAL_WIDTH (* SIZE TABLE_WIDTH))
  728.     (setq
  729.       TOTAL_HEIGHT
  730.        (+ (* TITLESIZE 2.0) (* (* NO_OF_ROWS 2.0) SIZE))
  731.     ) ;_ end of setq
  732.     (setq PT1 (list (+ (car SP) TOTAL_WIDTH) (cadr SP) 0.0))
  733.     (setq
  734.       PT2
  735.        (list (+ (car SP) TOTAL_WIDTH)
  736.              (- (cadr SP) TOTAL_HEIGHT)
  737.              0.0
  738.        )
  739.     ) ;_ end of setq
  740.     (setq PT3 (list (car SP) (- (cadr SP) TOTAL_HEIGHT) 0.0))
  741.     (setq TEMP (getvar "plinewid"))
  742.     (setvar "plinewid" 0.011)
  743.     (if        (= (tblsearch "layer" "TABLE") NIL)
  744.       (command "layer" "make" "TABLE" "color" "red" "" "set" "TABLE" "")
  745.     ) ;_ end of if
  746.     (command "layer" "set" "TABLE" "")
  747.     (if        (= (tblsearch "style" "romans") NIL)
  748.       (command "style" "romans" "romans.shx" "" "" "" "" "" "")
  749.     ) ;_ end of if
  750.     (if        (= (tblsearch "style" "romand") NIL)
  751.       (command "style" "romand" "romand.shx" "" "" "" "" "" "")
  752.     ) ;_ end of if
  753.     (command "pline" SP PT1 PT2 PT3 "close")
  754. ;;;;Draw horizontal lines in Table;;;;
  755.     (setq ROW_NDX 1)
  756.     (repeat NO_OF_ROWS
  757.       (setq
  758.         LP (list
  759.              (car SP)
  760.              (- (cadr SP) (+ (* (* SIZE 2.0) ROW_NDX)) SIZE)
  761.              0.0
  762.            ) ;_ end of list
  763.       ) ;_ end of setq
  764.       (setq
  765.         RP (list
  766.              (car PT1)
  767.              (- (cadr SP) (+ (* (* SIZE 2.0) ROW_NDX)) SIZE)
  768.              0.0
  769.            ) ;_ end of list
  770.       ) ;_ end of setq
  771.       (command "line" LP RP "")
  772.       (setq ROW_NDX (1+ ROW_NDX))
  773.     ) ;_ end of repeat
  774. ;;;;Draw vertical lines in Table;;;;
  775.     (setq NDX 1)
  776.     (repeat (- NO_OF_COLS 1)
  777.       (if (= NDX 1)
  778.         (setq
  779.           TP (list
  780.                (+ (car SP) (* COLUMN1 SIZE))
  781.                (- (cadr SP) (* TITLESIZE 2.0))
  782.                0.0
  783.              ) ;_ end of list
  784.         ) ;_ end of setq
  785.         (setq
  786.           TP (list
  787.                (+ (car (getvar "lastpoint"))
  788.                   (* (eval (read (strcat "column" (itoa NDX)))) SIZE)
  789.                ) ;_ end of +
  790.                (- (cadr SP) (* TITLESIZE 2.0))
  791.                0.0
  792.              ) ;_ end of list
  793.         ) ;_ end of setq
  794.       ) ;_ end of if
  795.       (if (= NDX 1)
  796.         (setq BP (list (+ (car SP) (* COLUMN1 SIZE)) (cadr PT3) 0.0))
  797.         (setq
  798.           BP (list
  799.                (+ (car (getvar "lastpoint"))
  800.                   (* (eval (read (strcat "column" (itoa NDX)))) SIZE)
  801.                ) ;_ end of +
  802.                (cadr PT3)
  803.                0.0
  804.              ) ;_ end of list
  805.         ) ;_ end of setq
  806.       ) ;_ end of if
  807.       (command "line" TP BP "")
  808.       (setq NDX (1+ NDX))
  809.     ) ;_ end of repeat
  810.     (setvar "plinewid" TEMP)
  811. ;;;;Place Table Title text;;;;
  812.     (setq
  813.       TITLE_LOC
  814.        (list
  815.          (+ (car SP) (* TOTAL_WIDTH 0.5))
  816.          (- (cadr SP) TITLESIZE)
  817.        ) ;_ end of list
  818.     ) ;_ end of setq
  819.     (setvar "textstyle" "romand")
  820.     (command "text" "j" "mc" TITLE_LOC TITLESIZE "0" TITLE)
  821.     (setvar "textstyle" "romans")
  822. ;;;;Place matrix text;;;;
  823.     (setq COL_NDX 1)
  824.     (setq ROW_NDX 1)
  825.     (repeat NO_OF_COLS
  826.       (if (= COL_NDX 1)
  827.         (setq
  828.           HP (+        (car SP)
  829.                 (* (eval (read (strcat "column" (itoa COL_NDX))))
  830.                    HALFSIZE
  831.                 ) ;_ end of *
  832.              ) ;_ end of +
  833.         ) ;_ end of setq
  834.         (setq
  835.           HP
  836.            (+
  837.              HP
  838.              (+        (* (eval (read (strcat "column" (itoa (- COL_NDX 1)))))
  839.                    HALFSIZE
  840.                 ) ;_ end of *
  841.                 (* (eval (read (strcat "column" (itoa COL_NDX))))
  842.                    HALFSIZE
  843.                 ) ;_ end of *
  844.              ) ;_ end of +
  845.            ) ;_ end of +
  846.         ) ;_ end of setq
  847.       ) ;_ end of if
  848.       (setq ROW_NDX 1)
  849.       (repeat NO_OF_ROWS
  850.         (if (= ROW_NDX 1)
  851.           (setq VP (- (cadr SP) (* SIZE 4)))
  852.           (setq VP (- VP (* SIZE 2)))
  853.         ) ;_ end of if
  854.         (setq LOC (list HP VP 0.0))
  855.         (command
  856.           "text"
  857.           "j"
  858.           "mc"
  859.           LOC
  860.           SIZE
  861.           "0"
  862.           (eval
  863.             (read (strcat "row" (itoa ROW_NDX) "col" (itoa COL_NDX)))
  864.           ) ;_ end of eval
  865.         ) ;_ end of command
  866.         (setq ROW_NDX (1+ ROW_NDX))
  867.       ) ;_ end of repeat
  868.       (setq COL_NDX (1+ COL_NDX))
  869.     ) ;_ end of repeat
  870. ;;;;Delete Matrix Variables
  871.     (setq CNT 1)
  872.     (while (<= CNT NDX)
  873.       (set (read (strcat "column" (itoa CNT))) NIL)
  874.       (setq CNT (1+ CNT))
  875.     ) ;_ end of while
  876.     (setq COL_NDX 1)
  877.     (setq ROW_NDX 1)
  878.     (repeat NO_OF_COLS
  879.       (if (= COL_NDX 1)
  880.         (set (read (strcat "column" (itoa COL_NDX))) NIL)
  881.         (set (read (strcat "column" (itoa (- COL_NDX 1)))) NIL)
  882.       ) ;_ end of if
  883.       (setq ROW_NDX 1)
  884.       (repeat NO_OF_ROWS
  885.         (set
  886.           (read (strcat "row" (itoa ROW_NDX) "col" (itoa COL_NDX)))
  887.           NIL
  888.         ) ;_ end of set
  889.         (setq ROW_NDX (1+ ROW_NDX))
  890.       ) ;_ end of repeat
  891.       (setq COL_NDX (1+ COL_NDX))
  892.     ) ;_ end of repeat
  893.     (setvar "osmode" OSMODE)
  894.     (setvar "cecolor" CECOLOR)
  895.     (setvar "clayer" CLAYER)
  896.   ) ;_ end of Defun
  897. ;;; initialize value settings ;;;
  898.   (setq
  899.     TOG_VALUE "0"
  900.     OL              (getvar "clayer")
  901.     OS              (getvar "textstyle")
  902.     OC              (getvar "cmdecho")
  903.   ) ;_ end of setq
  904. ;;; define error routine ;;;
  905.   (setq TABLE_ERR *ERROR*)
  906.   (Defun *ERROR* (MSG)
  907.     (princ MSG)
  908.     (setq *ERROR* TABLE_ERR)
  909.     (if        OL
  910.       (setvar "clayer" OL)
  911.     ) ;_ end of if
  912.     (if        OS
  913.       (setvar "textstyle" OS)
  914.     ) ;_ end of if
  915.     (if        OC
  916.       (setvar "cmdecho" OC)
  917.     ) ;_ end of if
  918.     (setq FD (open "symtos.txt" "w"))
  919.     (princ "" FD)
  920.     (close FD)
  921.     (princ)
  922.   ) ;_ end of Defun
  923. ;;; Perform creation of dialog, input dialog & set global Handle (*Tableid*) ;;;
  924.   (if (not *TABLEID*)
  925. ;;; first time thru
  926.     (progn
  927.       (DCL_TEMP)
  928.       (if (< (setq *TABLEID* (load_dialog "temp.dcl")) 0)
  929.         (*ERROR* "对话框数据错误")
  930.       ) ;_ end of if
  931.     ) ;_ end of progn
  932.   ) ;_ end of if
  933.   (DLG_MAIN)
  934. ;;;   restore error handler and exit   ;;;
  935.   (terpri)
  936. ) ;_ end of Defun
  937. (princ)
setq, end, NDX

相关帖子

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

树櫴希德
发表于 2014-3-19 19:43:52 | 显示全部楼层
怎么没有人顶啊
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

lxy_2080

已领礼包: 22个

财富等级: 恭喜发财
发表于 2014-4-1 13:00:43 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
这个不错。就是表格的宽度没找到在哪儿修改的。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

qyming1996

已领礼包: 329个

财富等级: 日进斗金
发表于 2014-7-29 15:08:28 | 显示全部楼层
表格绘制，正在学这个
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

leechqm

已领礼包: 217个

财富等级: 日进斗金
发表于 2014-9-24 12:32:11 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
路過看看:D
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

qq2223
发表于 2019-10-31 17:33:40 | 显示全部楼层
支持点赞！！！！
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-9-23 10:30 , Processed in 0.206896 second(s), 43 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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