找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 5108|回复: 36

[LISP程序]:我编写的自动生成表格

[复制链接]
发表于 2006-12-24 12:57:00 | 显示全部楼层 |阅读模式

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

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

×

  1.   [FONT=courier new]
  2. (if (not (member 'c:ShowZWXFCRegInf (atoms-family 0))) (exit))
  3. (if (not (member 'Edit-InfSetFile (atoms-family 0))) (load "FCinfset.VLX"))
  4. (if (not (member 'ZWX::GetFCInf (atoms-family 0)))(load "ioFCInf.fas"))

  5.   (defun ZWX::bgGetSet ( / a) ;设置参数
  6.     (setq a (ZWX::GetFCInf nil)
  7.           bgbh (cadr (assoc "BGBH" a))                   jzmj (cadr (assoc "JZMJ" a))
  8.           fwzl (cadr (assoc "FWZL" a))                   fwmc (cadr (assoc "FWMC" a))
  9.           wtdw (cadr (assoc "WTDW" a))                   tfbh (cadr (assoc "TFBH" a))
  10.           zcc (cadr (assoc "ZCC" a))                     clrq (cadr (assoc "CLRQ" a))
  11.           dxhtrq (cadr (assoc "DXHTRQ" a))               fcbl (cadr (assoc "FCBL" a))
  12.           dxbl (cadr (assoc "DXBL" a))                   HANGJU (cadr (assoc "HANGJU" a))
  13.           CQorYSorJZ_MJ (cadr (assoc "CQORYSORJZ_MJ" a)) PAGEisROWorCOL (cadr (assoc "PAGEISROWORCOL" a))
  14.           PAGEOFFSET (cadr (assoc "PAGEOFFSET" a))       SWHEIGHT (cadr (assoc "SWHEIGHT" a))
  15.           ZTDX (cadr (assoc "ZTDX" a))                   CHHTY (cadr (assoc "CHHTY" a))
  16.           ZYS (cadr (assoc "ZYS" a))                     XSGC (cadr (assoc "XSGC" a))
  17.           JSJG (cadr (assoc "JSJG" a))                   DXTYS (cadr (assoc "DXTYS" a))
  18.           GCPMTYS (cadr (assoc "GCPMTYS" a))

  19.           ;指定纸张大小fixPAGESIZE;
  20.           fixPAGESIZE (cadr (assoc "PAGESIZE" a))
  21.           ;纸张打印方向fixPAGEFX;
  22.           fixPAGEFX (cadr (assoc "PAGEFX" a))
  23.           
  24.           ;字体宽度比例是否可以任意设置ZTBLLimit;
  25.           ZTBLLimit (cadr (assoc "ZTBLLIMIT" a))
  26.           ;最小宽度比例限制LimitValue;
  27.           LimitValue (cadr (assoc "LIMITVALUE" a))

  28.           a (nth (atoi SWHEIGHT) '(9.6 8.4 7.3 6.4 5.4 5.1 4.8 4.2 3.5 3.1 2.7 2.4 2.0 1.7))
  29.           SWHEIGHT (if a a 3.5)
  30.     )
  31.   )

  32. (defun ZWX::bgGetPage (col / size fx1)
  33.           ;;若未指定页规格
  34.       (if (not (or (= "a3" pagesize) (= "a4" pagesize)))
  35.          (cond
  36.           ((and (= 0 fixPAGESIZE) (= 0 fixPAGEFX))
  37.             (cond
  38.               ((< 32 col) (setq size "a3" fx1 1))
  39.               ((< 16 col) (setq size "a4" fx1 1))
  40.               (t (setq size "a4" fx1 2))
  41.             )
  42.           )
  43.           ((and (= 0 fixPAGESIZE) (/= 0 fixPAGEFX))
  44.            (if (= 1 fixPAGEFX)
  45.             (cond
  46.               ((< 32 col) (setq size "a3" fx1 1))
  47.               ((< 16 col) (setq size "a4" fx1 1))
  48.               (t (setq size "a4" fx1 1))
  49.             )
  50.             (cond
  51.               ((< 32 col) (setq size "a3" fx1 2))
  52.               ((< 16 col) (setq size "a3" fx1 2))
  53.               (t (setq size "a4" fx1 2))
  54.             )
  55.            )
  56.           )
  57.           ((and (/= 0 fixPAGESIZE) (= 0 fixPAGEFX))
  58.            (if (= 1 fixPAGESIZE)
  59.             (cond        ;a4
  60.               ((< 32 col) (setq size "a4" fx1 1))
  61.               ((< 16 col) (setq size "a4" fx1 1))
  62.               (t (setq size "a4" fx1 2))
  63.             )
  64.             (cond   ;a3
  65.               ((< 32 col) (setq size "a3" fx1 1))
  66.               ((< 16 col) (setq size "a3" fx1 2))
  67.               (t (setq size "a3" fx1 2))
  68.             )
  69.            )
  70.           )
  71.           (t
  72.             (setq size (nth (1- fixPAGESIZE) '("a4" "a3")) fx1 fixPAGEFX)
  73.           )
  74.         )

  75.        
  76.        
  77.         (if (= 0 fixPAGEFX)
  78.            (if (= "a4" pagesize)
  79.             (cond        ;a4
  80.               ((< 32 col) (setq size "a4" fx1 1))
  81.               ((< 16 col) (setq size "a4" fx1 1))
  82.               (t (setq size "a4" fx1 2))
  83.             )
  84.             (cond   ;a3
  85.               ((< 32 col) (setq size "a3" fx1 1))
  86.               ((< 16 col) (setq size "a3" fx1 2))
  87.               (t (setq size "a3" fx1 2))
  88.             )
  89.            )
  90.           (setq size pagesize fx1 fixPAGEFX)
  91.          )
  92.     )   
  93.       (setq pagesize size fixPAGEFX fx1)
  94.       ;页的大小
  95.       (if (= size "a4")
  96.         (progn
  97.         (setq insertEmptyPAGE "FCBG_EmptyPAGE_A4" FCBGFixHead "FCBG_FixHead_A4")
  98.         (if (= 1 fx1)
  99.         (setq insertEmptyPAGE (strcat insertEmptyPAGE "h")
  100.               PAGEwidth 297.0 PAGEheight 210.0 printPAGEheight 195.0 TableWidth 257.0 OffsetPrintX 20)
  101.         (setq PAGEwidth 210.0 PAGEheight 297.0 printPAGEheight 277.00 TableWidth 180.0 OffsetPrintX 15)
  102.         ))
  103.         (progn
  104.         (setq insertEmptyPAGE "FCBG_EmptyPAGE_A3" FCBGFixHead "FCBG_FixHead_A3")
  105.         (if (= 1 fx1)
  106.         (setq insertEmptyPAGE (strcat insertEmptyPAGE "h")
  107.               PAGEwidth 420.0 PAGEheight 297.0 printPAGEheight 282.0 TableWidth 380.0 OffsetPrintX 20)
  108.         (setq PAGEwidth 297.0 PAGEheight 420.0 printPAGEheight 400.00 TableWidth 267.0 OffsetPrintX 15)
  109.         ))
  110.       )
  111.   )

  112.   ;插入块
  113.   (defun ZWX::bgInsertBlock (BlockName InsertPoint)
  114.     (command "insert" BlockName InsertPoint "" "" ""); "explode" (entlast))
  115.   )

  116.   ;绘表格线
  117.   (defun ZWX::bgDrawLine (StartPoint EndPoint / ent)
  118.     (command "_line" StartPoint EndPoint ""
  119.              "chprop" (setq ent (entlast)) "" "c" "blue" "la" "表格" ""
  120.     )
  121.     ent
  122.   )

  123.   ;输出表格中指定行数据
  124.   (defun ZWX::bgPriGridRowData (LeftTopPoint Offset RowData aColsWidth CurRow /
  125.                        j
  126.                        cellText CellWidth CellPoint
  127.                        CellHeightest RowNum
  128.                        isWrap
  129.                        allCellInf
  130.                        TextStyle zh
  131.                        temp
  132.                       )
  133.         ;;;写行数据
  134.         (setq j 0
  135.               CellPoint (polar LeftTopPoint (* 1.5 pi) Offset)
  136.               CellHeightest 0
  137.         )
  138.         (foreach CellText RowData
  139.           (setq CellWidth (nth j aColsWidth)
  140.                 isWrap (not (numberp (read CellText)))  ;面积的数据不允许回绕(vl-string-search "." CellText)
  141.                 j (1+ j)
  142.                 TextStyle (if (= 0 CurRow) "FixText" "data")
  143.                 zh (if (or (= 1 j) (= (length RowData) j)) swheight zjheight)
  144.           )
  145.           
  146.           (setq temp (ZWX::bgprint1 CellWidth CellText CellPoint zh 0 TextStyle "mc" "white" "数据" isWrap)) ;首尾大号字
  147.           (if (< CellHeightest (cadr temp))(setq CellHeightest (cadr temp) RowNum (cadddr temp)))  ;最大行高
  148.           (setq CellPoint (car temp) allCellInf (cons (cdr temp) allCellInf))
  149.         )

  150.         ;当该行有绕行情况,则重新调整各数据的位置,以保证位于单元格的中心位置
  151.         (if (> RowNum 1)
  152.           (foreach temp allCellInf
  153.             (if (< (caddr temp) RowNum)
  154.               (command "move" (cadr temp) "" "0,0,0" (strcat "@0," (rtos (/ (- (car temp) CellHeightest) 2))))
  155.             )
  156.           )
  157.         )
  158.     CellHeightest
  159.   )

  160. (defun ZWX::bgOrientPage (InsertPoint insertOffSet insertFixHead aPageSize /
  161.                            X1 y1 P1 P2 P3 an
  162.                           )
  163.            (ZWX::bgInsertBlock insertEmptyPAGE InsertPoint);页
  164.           
  165.            (setq X1 (car InsertPoint) y1 (cadr InsertPoint)
  166.                  p1 (list (+ (car InsertPoint) 33.5563) (- (cadr InsertPoint) 32.17894))
  167.                  p2 (list (+ (car InsertPoint) 166.6342) (- (cadr InsertPoint) 32.17894))
  168.                  p3 (if (= 2 fixPAGEFX) (list (+ (car InsertPoint) 183.315) (- (cadr InsertPoint) 14.778))
  169.                                         (list (+ (car InsertPoint) 12.778) (- (cadr InsertPoint) 24.4))
  170.                     )
  171.                  an (if (= 2 fixPAGEFX) 0 90)
  172.            )
  173.   
  174.            (if insertFixHead
  175.              (progn
  176.                (if insertFixHead (ZWX::bgInsertBlock FCBGFixHead InsertPoint))
  177.                  
  178.                ;写坐落
  179.                (setq i 0)
  180.                (while (and (< i (strlen ZCC)) (setq a (substr ZCC (setq i (1+ i)))) (not (numberp (setq bb (read a))))))
  181.                (cond
  182.                   ((= "" ZCC)(setq bb ""))
  183.                   ((and (/= "" ZCC) (= "" bb))(setq bb "1"))
  184.                   ((and (/= "" ZCC) (not (numberp bb)))(setq bb "1"))
  185.                   (t (setq bb (itoa bb)))
  186.                )
  187.                (IF (= aPageSize "a4")
  188.                  (setq a (ZWX::bgprint1 55 FWZL P1 3.5 0 "data" "bl" "white" "数据" nil)
  189.                        a (ZWX::bgprint1 20 bb P2 3.5 0 "data" "bl" "white" "数据" nil)
  190.                  )
  191.                  (setq a (ZWX::bgprint1 55 FWZL P1 3.5 0 "data" "bl" "white" "数据" nil)
  192.                        a (ZWX::bgprint1 20 bb P2 3.5 0 "data" "bl" "white" "数据" nil)
  193.                  )
  194.                )
  195.              )
  196.            )

  197.            ;打印页码
  198.            (IF (= aPageSize "a4")
  199.              (setq a (ZWX::bgprint1 3.7 (itoa page2) P3 2.5 an "data" "mc" "white" "数据" nil))
  200.              (setq a (ZWX::bgprint1 3.7 (itoa page2) P3 2.5 an "data" "mc" "white" "数据" nil))
  201.            )
  202. )

  203. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  204. ;;;子程序
  205. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  206. ;;;----------------ZWX::bgReadCGB------------------------------------------
  207. (defun ZWX::bgRtos (data / a re)
  208.   (mapcar '(lambda (a) (rtos a 2 3)) data)
  209. )

  210. (defun ZWX::bgSave1(l1 / a b
  211.                          l2 head
  212.                          xj hj ixj ihj  ;小计xj 合计hj;
  213.                     xjorhj i
  214.                    )
  215.   (if (< oldLX 3)(progn
  216.     (setq ixj 0 ihj 0 l1 (reverse l1) head (car l1))
  217.     (while (setq a (car l1))
  218.       (cond
  219.         ((and (or (= "==xj" a) (= "==hj" a))
  220.               (< 1 ixj)
  221.          )
  222.           (setq b (ZWX::bgRtos (if (= "==xj" a) xj hj))
  223.                 b (append (if (= "==xj" a) '(("小计" "-")) '(("合计" "-"))) (cddr b))
  224.                 l2 (cons b l2)
  225.                 re$ (cons (cons oldLX (list (reverse l2))) re$)
  226.                 l2 (list head)
  227.                 xjorhj t i 0
  228.           )
  229.           (if (= "==xj" a) (setq xj nil ixj 0 ) (setq hj nil ihj 0))
  230.           (if (not (and (setq a (cadr l1))
  231.                         (setq a (substr a 1 3))
  232.                         (or (= "==n" a) (= "==p" a))
  233.                    )
  234.               )
  235.             (setq re$ (cons '(3 . ("==n")) re$))
  236.           )
  237.         )

  238.          ;;;          (setq xj (ZWX::bgRtos xj)
  239. ;;;                xj (append '(("小计" "-")) (cddr xj))
  240. ;;;                l2 (cons xj l2)
  241. ;;;                re$ (cons (cons oldLX (list (reverse l2))) re$)
  242. ;;;                re$ (cons '(3 . ("==n")) re$)
  243. ;;;                xj nil ixj 0 l2 (list head)
  244. ;;;          )
  245. ;;;        ((and (= "==hj" a) (< 1 ixj))
  246. ;;;          (setq hj (ZWX::bgRtos hj)
  247. ;;;                hj (append '(("合计" "-")) (cddr hj))
  248. ;;;                l2 (cons hj l2)
  249. ;;;                re$ (cons (cons oldLX (list (reverse l2))) re$)
  250. ;;;                re$ (cons '(3 . ("==n")) re$)
  251. ;;;                hj nil ihj 0 l2 nil
  252. ;;;          )
  253. ;;;        )
  254.         ((or (= "==n" (substr a 1 3))
  255.              (= "==p" (substr a 1 3))
  256.          )
  257.            (if (not xjorhj) (setq l2 nil))
  258.            (setq re$ (cons (cons 3 (list a)) re$))
  259.         )
  260.         (t
  261.           ;表格数据字段数小于最大个数应以空格字符补齐;
  262.           (setq b (length a))
  263.           (if (> LenRow b)
  264.             (setq b (vlax-make-safearray vlax-vbString (cons 0 (- LenRow b)))
  265.                   b (vlax-safearray->list b)  
  266.                   a (append a b)  ;空格字符后位补齐;
  267.             )
  268.           )
  269.          ;小计和合计;
  270.           (setq l2 (cons a l2)

  271.                 b (mapcar 'atof a)
  272.                 xj (if (= 0 ixj) b (mapcar '+ xj b))
  273.                 hj (if (= 0 ihj) b (mapcar '+ hj b))
  274.                 ixj (1+ ixj)
  275.                 ihj (1+ ihj)
  276.           )
  277.         )
  278.       )
  279.       (setq l1 (cdr l1))

  280.       (if xjorhj (if (= 1 i) (setq xjorhj nil i 0) (setq i (1+ i))))
  281.     )
  282.    
  283.     (if l2 (cons (cons oldLX (list (reverse l2))) re$))
  284.   )
  285.     (cons (cons oldLX (list (reverse l1))) re$)
  286.   )
  287.   
  288. )

  289.   (defun ZWX::bgReadCGB (_fn /
  290.                          line line1 f$  re$ FCVer Save
  291.                          count a b
  292.                          dataLX oldLX ;数据类型;
  293.                          fixGS   ;格式符类型 1==xj 2==hj 3 ==n 4==p
  294.                          ll
  295.                          LenRow

  296.                          l$ l2
  297.                          
  298.                         )
  299.     (setq dataLX 3 count 0)
  300.     (if        (setq f$ (open _fn "r")) (progn
  301.       (while (setq line (read-line f$))
  302.         (cond
  303.           ((or (= " " line) (= "" line)))
  304.           ((wcmatch (strcase line) "FENTAN-NUMBER*")(setq ll nil))
  305.           (t (setq ll (cons line ll)))
  306.         )
  307.       )(close f$)
  308.       
  309.       (foreach line (reverse ll)
  310.         (setq fixGS 0)
  311.         (cond
  312.           ((not line)(setq line nil fixGS 3))
  313.           ((= "" (vl-string-trim " " line))(setq line "==n" fixGS 3))
  314.           ((= "==xj" line)(setq fixGS 1))
  315.           ((= "==hj" line)(setq fixGS 2))
  316.           ((= "==n" (substr line 1 3))(setq fixGS 3))
  317.           ((= "==p" (substr line 1 3))(setq fixGS 4))
  318.           
  319.           ((wcmatch line "FENTAN-VER=*")
  320.             (setq a (ZWX::Split line (list "=") nil)
  321.                   l$ nil re$ nil old$ 3
  322.                   FCVer (if (cadr a) (atof (cadr a)) 0)
  323.             )
  324.           )
  325.           ((or (= "fentan-jzshuju" line)
  326.                (= "==tn" line)
  327.                (and (< FCVer 7) (= "房号" (substr line 1 4))))
  328.              (setq dataLX 1 count 0 Save t LenRow 0 ixj 0 ihj 0)
  329.           )
  330.           ((or (= "fentan-gyshuju" line)
  331.                (= "==gy" line)
  332.                (and (< FCVer 7) (= "项目" (substr line 1 4))))
  333.              (setq dataLX 2 count 0 Save t LenRow 0 ixj 0 ihj 0)
  334.           )
  335.           ((or (= "fentan-bzsm" line) (= "==sm" line))
  336.              (setq dataLX 3 count 0 Save t)
  337.           )
  338.         )
  339.        
  340.         (if (and Save l$)
  341.           (setq re$ (ZWX::bgSave1 l$) l$ nil)
  342.         )

  343.         (cond
  344.           ((not line))
  345.           ((= "" line))
  346.           ((member line '("==tn" "==gy" "==sm")))
  347.           ((= "fentan-" (strcase (substr line 1 7) t)))
  348.           ((= 3 dataLX)
  349.             (cond
  350.               ((= 1 fixGS))
  351.               ((= 2 fixGS))
  352.               (t (setq l$ (cons line l$)))
  353.             )
  354.           )
  355.           (t
  356.             (cond
  357.               ((< 0 fixGS)(setq l$ (cons line l$)))
  358.               (t
  359.                 (setq a (ZWX::Split line (list (chr 9)) nil)
  360.                      
  361.                       l$ (cons a l$)
  362.                       a (length a)
  363.                       LenRow (if (< LenRow a) a LenRow)
  364.                 )
  365.               )
  366.             )
  367.           )
  368.         )

  369.         (setq oldLX dataLX count (1+ count))
  370.         (if (and (< dataLX 3) (< FCVer 7) (= "合计" (substr line 1 4)))
  371.              (setq Save t dataLX 3)
  372.              (setq Save nil)
  373.         )
  374.       ) ;foreach

  375.       (if l$ (setq re$ (ZWX::bgSave1 l$) l$ nil))
  376.       (setq re$ (reverse re$))
  377.     ) )
  378. ;;;   (princ re$)
  379.   )

  380. ;是否允许多行打印PermitWrap
  381. ;
  382. (defun ZWX::bgprint1 (_collen _text _Leftcoor _height angle1 _style _Justify _color _layer PermitWrap /
  383.                 _position jianxu
  384.                 entg Text1 Text2 i a b c
  385.                 LL RL aWidth
  386.                 newText        newWidth
  387.                 bRowHeight
  388.                 len1
  389.                 SSText
  390.                )
  391.    (setq Text1 (if (= "—" _text) "-" _text)
  392.          i (strlen Text1)
  393.          entg (list (cons 7 _style)  ;字体类型
  394.                     (cons 40 _height) ;高度
  395.               )
  396.          aWidth 1
  397.          Text2 Text1
  398.          jianxu 1.2
  399.    )
  400.    ;(textbox '((1 . "层次:") (7 . "HZTXT") (41 . 0.85) (40 . 3.5)))
  401.    
  402.    (while (and PermitWrap (< 1 i))
  403.      (setq a (substr Text1 1 i)
  404.            Text2 (substr Text1 (1+ i))
  405.            b (textbox (append (list (cons 1 a)) entg))
  406.            LL (caar b)
  407.            RL (caadr b)
  408.            aWidth (- RL LL)
  409.            aWidth (if (equal 0 aWidth 0) 1 (/ (- _collen jianxu jianxu) aWidth))
  410.      )
  411.      (if (< aWidth 0.6)
  412.        (setq i (if (> (ascii a) 128) (- i 2) (1- i)))
  413.        (progn
  414.          (if (< 1 aWidth)(setq aWidth 1))
  415.          (setq newText (cons a newText)
  416.                newWidth (cons aWidth newWidth)
  417.                Text1 (substr Text1 (1+ i))
  418.                i (strlen Text1)
  419.          )
  420.        )
  421.      )
  422.    )
  423.    
  424.    (if (/= "" Text2)
  425.      (setq newText (cons Text2 newText)
  426.            newWidth (cons aWidth newWidth)
  427.      )
  428.    )
  429.    (setq newText (reverse newText)
  430.          newWidth (reverse newWidth)
  431.          bRowHeight 0
  432.          SSText (ssadd)
  433.          i 0
  434.    )
  435.    ;jianxu 字与边界的间隙
  436.    ;text字的内容,col输入所在列数,collen当前列的列宽,Leftcoor当前列的最左坐标,
  437.    
  438.    (cond
  439.      ((wcmatch _Justify "*l*")(setq _position _Leftcoor))
  440.      ((wcmatch _Justify "*c*")(setq _position (polar _Leftcoor 0 (/ _collen 2.000))))
  441.      ((wcmatch _Justify "*r*")(setq _position (polar _Leftcoor 0 _collen)))
  442.    )
  443.    
  444.    (if (= 2 (length _position))(setq _position (append _position '(0))))
  445.                     
  446.    (foreach a newText
  447.      (command "text" "s" _style "j" _Justify _position _height angle1 a
  448.               "chprop" (entlast) "" "c" _color "la" _layer ""
  449.      )
  450.      (setq b (entget (entlast))
  451.            a (* 0.8 (if (= "-" a) 2 (nth i newWidth)))
  452.            b (subst (cons 41 a) (assoc 41 b) b)
  453.            _position (polar _position (* 1.5 pi) (+ 0.2 _height))
  454.            bRowHeight (+ bRowHeight (if (> i 0) 0.2 0) _height)
  455.            SSText (ssadd (entlast) SSText)
  456.            i (1+ i)
  457.      )
  458.      (entmod b)
  459.    )

  460.   ;返回下一个输出点及当前本行的高度
  461.    (list (polar _Leftcoor 0 _collen) bRowHeight SSText i)
  462. )

  463.   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  464.   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  465.   (defun ZWX::bgNextPage (thepagepoint / _nextpagepoint)
  466.     (if (= PAGEisROWorCOL "0")                                ;各页为横向排列或竖向排列
  467.       (setq _nextpagepoint (polar thepagepoint 0 (+ PAGEoffset PAGEwidth)))             ;横向
  468.       (setq _nextpagepoint (polar thepagepoint (* 1.5 pi) (+ PAGEoffset PAGEheight)))   ;竖向
  469.     )
  470.     _nextpagepoint
  471.   )

  472.   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  473.   ;;;封面
  474.   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  475.   (defun ZWX::bgpriCOVER (cover_p / _a _b _c _p)
  476.     (setq PAGEwidth 210.0 PAGEheight 297.0 printPAGEheight 267.69
  477.           _a (list BGBH FWZL TFBH FWMC WTDW "三明市测量队" CLRQ)
  478.           _p (list (+ (car cover_p) 76.32518) (- (cadr cover_p) 143.29072))
  479.     )
  480.     (command "insert" "FCBG_COVER1" cover_p "" "" ""); "explode" (entlast)) ;封面1
  481.     (foreach _b _a (progn
  482.      (if (= "" _b)(setq _b "?????"))
  483.      (setq _c (ZWX::bgprint1 80 _b _p 3.5 0 "DATA" "mc" "white" "数据" nil)
  484.            _p (polar _p (* 1.5 pi) 8)
  485.      )
  486.     ))
  487.     (setq cover_p (ZWX::bgNextPage cover_p))
  488.     (command "insert" "FCBG_COVER2" cover_p "" "" ""); "explode" (entlast)) ;;封面2
  489.     (setq cover_p (ZWX::bgNextPage cover_p))
  490.     cover_p
  491.   )

  492.   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  493.   ;;;目录
  494.   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  495.   (defun ZWX::bgpriLIST (LIST_p / _a _b _c _d _e _p)
  496.     ;ZYS XSGC JSJG DXTYS GCPMTYS
  497.     (if (or (not ZYS) (= "" ZYS))(setq ZYS "???"))
  498.     (if (or (not XSGC) (= "" XSGC))(setq XSGC "无"))
  499.     (if (or (not JSJG) (= "" JSJG))(setq JSJG "无"))
  500.     (if (or (not DXTYS) (= "" DXTYS))(setq DXTYS "???"))
  501.     (if (or (not GCPMTYS) (= "" GCPMTYS))(setq GCPMTYS "???"))
  502.     (setq PAGEwidth 210.0 PAGEheight 297.0 printPAGEheight 267.69)
  503.     (command "insert" "FCBG_LIST1" LIST_p "" "" ""); "explode" (entlast))

  504.     (setq _c (ZWX::bgprint1 5.7 ZYS  (list (+ (car LIST_p) 101.5567) (- (cadr LIST_p) 65.34037)) 3 0 "DATA" "c" "white" "数据" nil)
  505.           _c (ZWX::bgprint1 5.7 XSGC (list (+ (car LIST_p) 165.5954) (- (cadr LIST_p) 107.2063)) 3 0 "DATA" "c" "white" "数据" nil)
  506.           _c (ZWX::bgprint1 5.7 JSJG (list (+ (car LIST_p) 165.5954) (- (cadr LIST_p) 115.2063)) 3 0 "DATA" "c" "white" "数据" nil)
  507.           _c (ZWX::bgprint1 5.7 DXTYS (list (+ (car LIST_p) 165.5954) (- (cadr LIST_p) 123.2063)) 3 0 "DATA" "c" "white" "数据" nil)
  508.           _c (ZWX::bgprint1 5.7 GCPMTYS (list (+ (car LIST_p) 165.5954) (- (cadr LIST_p) 131.2063)) 3 0 "DATA" "c" "white" "数据" nil)
  509.     )
  510.     (ZWX::bgNextPage LIST_p)
  511.   )

  512.   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  513.   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  514.   ;;;页面左上角定位点_p,输出数据表print_l,为产权或共有CQMJorGYMJ,页面A3或A4规格pagesize
  515.   ;;;面积表格插入点对页定位点Y偏量old_Offset_Table 开始页数priPage
  516.   ;;;是否插入新页NewPage 表格跨页时输出次页起面积表格是否含表头haveHEADAfterFirstPage
  517.   ;;;首页是否插入固定页头insertFixHead
  518.   ;;;
  519.   (defun ZWX::bgpriMJB (_p print_l CQMJorGYMJ pagesize old_Offset_Table priPage NewPage haveHEADAfterFirstPage insertFixHead /
  520.                     a b c e f g i j aa bb b1 c1 i1 d1 startft page2
  521.                  Offset_Table
  522.                  CurRowNum ;当前页累计行数
  523.                  CountRow  ;总累计行数
  524.                  PrintRow  ;当前打印行数
  525.                  Head collen_l ;列宽表
  526.                  insertEmptyPAGE FCBGFixHead;插入空页 面积计算表头
  527.                  headheight ;当前行离建筑面积表格左上角的高度
  528.                  RowestLine LeftestLine;表头最下一条横线RowestLine,表最左边直线LeftestLine
  529.                  allColHeight ;本行的所有各列的高度
  530.                  AllExEnts    ;本行的所有竖线
  531.                  firstRowestLineP1 firstRowestLineP2;首行下横线
  532.                  firstRowestLineP3 firstRowestLineP4
  533.                  rowheight ;当前行度
  534.                  TableWidth  ;表格宽度
  535.                  sheight   ;当前行累计高度
  536.                  p_table p_line
  537.                  blank   
  538.                  collenleft collenright ;列宽头和尾
  539.                  drawline_l

  540.                     computepoint       ;表示是否计算过到达该页可打印的最底下的边界;
  541.                    )

  542.     (setq Offset_Table old_Offset_Table
  543.           head (car print_l)
  544.           page2 priPage
  545.           headheight 0
  546.     )
  547.    
  548.     (if print_l (progn
  549.     (if _p (progn
  550.       (ZWX::bgGetPage (length head))
  551.       ;;;
  552.       ;;;构建各列的列宽表collen_l
  553.       ;正常打印宽度为180,最大打印宽度为195
  554.       ;当按正常打印宽度180计算各数据列宽度小于10.2时,则按最大打印宽度195重新计算数据列度
  555.       ;当数据列宽度大于17.7时,则将所有列的宽度按等份算
  556.       ;
  557.       (setq
  558.             b 0 c 0 e nil
  559.             
  560.       )

  561.       ;预先设置固定字段宽度
  562.       (if (= "CQMJ" CQMJorGYMJ)
  563.       (foreach a head
  564.         (setq d nil)
  565.         (cond ((= "房号" a) (setq d 13.7))
  566.               ((= "层次" a) (setq d 10.2))
  567.               ((= "开间" a) (setq d 15.1))
  568.               ((= "套内" a) (setq d 15.1))
  569.               ((= "建筑面积" a) (setq d 17.7))
  570.         )
  571.         (if d (setq b (1+ b)              ;固定字段个数
  572.                     c (+ c d)             ;固定字段总宽度
  573.                     e (cons (cons a d) e) ;保存固定字段的宽度
  574.               )
  575.         )
  576.       )
  577.       )
  578.           
  579.       ;计算其余数据列宽度
  580.       (setq d (/ (- TableWidth c) (- (length head) b))) ;数据列的度
  581.           
  582.       ;若其余数据列宽度过大或过小则调整其宽度
  583.       (cond
  584.         ((< d 10.2)   ;过小
  585.           (setq TableWidth (+ TableWidth 15.0)          ;修改表格宽度
  586.                 d (/ (- TableWidth c) (- (length head) b)) ;修改数据列的宽度
  587.                 OffsetPrintX 7.5        ;修改表格的横向偏移量
  588.           )
  589.         )
  590.         ((>= d 17.7)     ;过大
  591.           (setq d (/ TableWidth (length head)))    ;修改所有列的宽度
  592.           (if (>= d 40) (setq d 35 TableWidth (* (length head) d)))
  593.           (foreach a e
  594.             (setq e (subst (cons (car a) d) a e))
  595.           )
  596.         )
  597.       )

  598.       ;最后的列宽表collen_l
  599.       (foreach a head
  600.         (setq b (if (setq c (assoc a e)) (cdr c) d)
  601.               collen_l (cons b collen_l)
  602.         )
  603.         (if (= "CQMJ" CQMJorGYMJ)
  604.         (cond
  605.           ((= "开间" a) (setq head (subst "套内使用及套内墙体建面和" a head)))
  606.           ((= "阳台" a) (setq head (subst "阳台建面" a head)))
  607.           ((= "半封阳台" a) (setq head (subst "半封阳台建面" a head)))
  608.           ((= "未封阳台" a) (setq head (subst "未封阳台建面" a head)))
  609.           ((= "非封阳台" a) (setq head (subst "非封阳台建面" a head)))
  610.           ((= "全封阳台" a) (setq head (subst "全封阳台建面" a head)))
  611.           ((= "封闭阳台" a) (setq head (subst "封闭阳台建面" a head)))
  612.           ((= "套内" a) (setq head (subst "套内建筑面积" a head)))
  613.         )
  614.         )
  615.       )

  616.       ;;;参数初始化
  617.       (setq collen_l (reverse collen_l)
  618.             print_l (subst head (car print_l) print_l)
  619.             CountRow 0 CurRowNum 0 sheight 0
  620.       )

  621.       (while (< CountRow (length print_l)) (progn

  622.         (if (= 0 CurRowNum) (progn
  623.          (if NewPage (progn

  624.            ;放样新空白页和表格
  625.            (command "zoom" "w" _p (list (+ (car _p) PAGEwidth) (- (cadr _p) PAGEheight) 0))
  626.           
  627.            ;(InsertPoint insertOffSet insertFixHead aPageSize
  628.            (ZWX::bgOrientPage _p Offset_Table (= startpage page2) PageSize)
  629.           
  630.          ));(if NewPage

  631.          (if (or (not old_Offset_Table) (> 20 old_Offset_Table))
  632.            (if (and insertFixHead (= startpage page2))
  633.              ;当首页且需要插入固定页头时Offset_Table=34.5
  634.               (setq Offset_Table 34.5) ;首页
  635.               (setq Offset_Table 20)   ;其他页
  636.            )
  637.          )
  638.          (setq p_table (list (+ (car _p) OffsetPrintX) (- (cadr _p) Offset_Table) 0))         ;插入表格位置
  639.          
  640.          ;绘表格最顶及最左边的一条线
  641.          (setq RowestLine (ZWX::bgDrawLine p_table (strcat "@" (rtos TableWidth) "<0"))
  642.                f p_table
  643.          )
  644.          ;用offset绘出所有的竖线并将所有的竖线保存于AllExEnts
  645.          (foreach a (append '(0) collen_l)
  646.            (setq f (polar f 0 a)               ;竖线上端点
  647.                  c (polar f (* 1.5 pi) 1)      ;竖线下端点
  648.                  LeftestLine (ZWX::bgDrawLine f c)   ;开始画线
  649.                  AllExEnts (cons (list LeftestLine c) AllExEnts)  ;保存所有竖线
  650.            )
  651.          )

  652.         ));(if (= 0 CurRowNum) (progn

  653.         ;每页表格是否输出该表格的第一行数据
  654.         (if (and (= 0 CurRowNum) (< priPage page2) haveHEADAfterFirstPage)
  655.           (setq i 0 CountRow (1- CountRow)) ;FixText
  656.           (setq i CountRow)
  657.         )
  658.         (setq rowheight limitrowheight
  659.               aa (nth i print_l)
  660.               ;;;写行据(ZWX::bgPriGridRowData LeftTopPoint Offset RowData aColsWidth)
  661.               allColHeight (ZWX::bgPriGridRowData p_table (+ sheight (/ rowheight 2)) aa collen_l i)
  662.        
  663.               rowheight (+ (* swheight HANGJU) allColHeight)
  664.               sheight (+ sheight rowheight)
  665.              
  666.               f (polar p_table (* 1.5 pi) sheight)
  667.               ;;;绘当前行的下线
  668.               RowestLine (ZWX::bgDrawLine f (strcat "@" (rtos TableWidth) "<0"))
  669.               CurRowNum (1+ CurRowNum)
  670.               computepoint nil
  671.         )
  672.        

  673.         ;;;若下一行超出打印范围则须插入新的一页
  674.         (if (< printPAGEheight (+ Offset_Table sheight limitrowheight headheight))
  675.           (setq CurRowNum 0
  676.                 _p (ZWX::bgNextPage _p)
  677.                 NewPage t old_Offset_Table nil page2 (1+ page2)
  678.                 Offset_Table nil
  679.                 computepoint t
  680.           )
  681.         )
  682.         (if (or (= 0 CurRowNum) (= (1+ CountRow) (length print_l)))(progn  ;(equal aa (last print_l))
  683.           ;;;将当前表格的所有竖线拉伸至表格尾部
  684.           ;;;创建选择集
  685.           (command "_extend" RowestLine "")
  686.           (foreach b1 AllExEnts (command b1))
  687.           (command "")
  688.           (if (and (not computepoint) (equal aa (last print_l)))
  689.             (setq p_table (polar p_table (* 1.5 pi) (+ headheight sheight 0.1))
  690.                   Offset_Table (- (cadr _p) (cadr p_table))
  691.             )
  692.           )
  693.           (setq sheight 0 AllExEnts nil)
  694.         ))

  695.         (setq CountRow (1+ CountRow) RowestLine nil)
  696.       ))
  697.           
  698. ;;;    (princ (> pageheight (+ Offset_Table swheight)))
  699.     ;;;返回当前报告页左上角点及产权面积表最下一横线标
  700.     (if (not computepoint)
  701.     (if (> pageheight (+ Offset_Table swheight))
  702.       (setq NewPage nil Offset_Table (+ Offset_Table swheight))
  703.       (setq NewPage t Offset_Table 25 page2 (1+ page2))
  704.     )
  705.     )

  706.      ))
  707.     )(princ "\n没有可填写的记录,记录为空!"))
  708.     (list _p Offset_Table pagesize page2 NewPage)
  709.   )
  710.   
  711.   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  712.   ;;;;;;;打印一般文字;;;;;;;;;;;;;;;;;;;;;;;

  713.   (defun ZWX::bgpriRemark (_p print_l pagesize old_Offset_Table priPage NewPage /
  714.                     a b c e f g i j aa bb startft page2
  715.                  Offset_Table
  716.                  head
  717.                  startft ;属分摊数据的开始位置
  718.                  collen_l ;列宽表
  719.                  ;插入第三页的名称insertPAGEn3 插入建筑面积表格的名称inserttable
  720.                  insertPAGEn3 insertPAGEn4 inserttable
  721.                  headheight ;当前行离建筑面积表格左上角的高度
  722.                  RowestLine ;表头最下一条横线
  723.                  firstRowestLineP1 firstRowestLineP2;首行下横线
  724.                  rowheight ;当前行高度
  725.                  sheight   ;当前行累计高度
  726.                  p_table p_line

  727.                    )

  728.     (setq Offset_Table old_Offset_Table page2 priPage)
  729.     (if print_l (progn
  730.     (if _p (progn
  731.       (ZWX::bgGetPage (length head))
  732.       ;;;参数初始化
  733.       (setq g 0 sheight 0 rowheight (* 1.2 swheight))

  734.       (foreach aa print_l (progn

  735.         (if (= 0 g) (progn ;放样表格
  736.          (if NewPage (progn
  737.            (command "zoom" "w" _p (list (+ (car _p) PAGEwidth) (- (cadr _p) PAGEheight) 0))
  738.            (ZWX::bgOrientPage _p Offset_Table (= startpage page2) PageSize)
  739.          ))
  740.          
  741.          (if (not old_Offset_Table)
  742.            (if (= 3 page2)
  743.               (setq Offset_Table 34.5) ;首页
  744.               (setq Offset_Table 20)   ;其他页
  745.            )
  746.          )
  747.          (setq p_table (polar _p (* 1.5 pi) Offset_Table))
  748.         ));(if (= 0 g) (progn

  749.         ;;;写行数据
  750.         (setq f (polar _p (* 1.5 pi) (+ Offset_Table sheight swheight))  ;(/ rowheight 2)
  751.               f (ZWX::bgprint1 (- pagewidth 30) aa (polar f 0 OffsetPrintX) swheight 0
  752.                         "remark"
  753.                         ;(if (wcmatch aa "*÷*") "remark" "FixText")
  754.                         "bl" "white" "数据" t
  755.                 )
  756.         )
  757.         (setq g (1+ g) sheight (+ sheight rowheight))

  758.         ;;;若下一行超出打印范围则须插入下一页
  759.         (if (< printPAGEheight (+ Offset_Table sheight))
  760.           (setq g 0 _p (ZWX::bgNextPage _p) NewPage t old_Offset_Table nil page2 (1+ page2))
  761.         )
  762.         (if (or (= 0 g) (eq aa (last print_l)))(progn
  763.           (if (eq aa (last print_l))
  764.             (setq p_table (polar p_table (* 1.5 pi) sheight)
  765.                   Offset_Table (- (cadr _p) (cadr p_table))
  766.             )
  767.           )
  768.           (setq sheight 0)
  769.         ))
  770.       ))
  771.     ;;;返回当前报告页左上角点及产权面积表最下一横线的坐标
  772.     (if (> printPAGEheight (+ Offset_Table swheight))
  773.       (setq NewPage nil Offset_Table (+ Offset_Table swheight))
  774.       (setq NewPage t Offset_Table 25 page2 (1+ page2))
  775.     )
  776.      ))
  777.     ))

  778.     (list _p Offset_Table pagesize page2 NewPage)
  779.   )

  780.   ;
  781.   ;
  782.   ;
  783.   (defun ZWX::bgReset (inflname / a b dwg_flpath) ;设置参数
  784.    (if inflname
  785.      (setq cgb_filename (ZWX::FilebyExName inflname "cgb"))
  786.      (setq cgb_filename (Get-thisFileName "cgb"))
  787.    )
  788.     (ZWX::bgGetSet)
  789.     (setq data_list (ZWX::bgReadCGB cgb_filename)
  790.           HANGJU (atof HANGJU)
  791.           PAGEoffset (atof PAGEoffset)
  792.           zjheight (* swheight 0.8)
  793.           limitrowheight (+ swheight (* swheight HANGJU))
  794.           ver1 "7.0"
  795.     )
  796.   )

  797. ;参数包括;指定打印页printnum,打印文件inPrintFile,文件类型FileType(特指cgb或dwg文件)
  798. (defun c:printfcbg (printnum inPrintFile FileType InfSetFile /
  799.                     p oldos oldl ver1
  800.                  data_list
  801.                     
  802.                  bgbh jzmj fwzl fwmc wtdw tfbh zcc clrq dxhtrq fcbl dxbl
  803.                  HANGJU CQorYSorJZ_MJ
  804.                  ZTDX CHHTY
  805.                  ZYS XSGC JSJG DXTYS GCPMTYS        ;总页数ZYS  计算过程XSGC JSJG

  806.                     fixPAGESIZE fixPAGEFX
  807.                     ZTBLLimit LimitValue
  808.                  
  809.                  cgb_filename

  810.                  PAGEwidth  PAGEheight     ;页宽PAGEwidth 页高PAGEheight
  811.                  PAGEisROWorCOL PAGEoffset ;各页为横向排列或竖向排列PAGEisROWorCOL 页与页之间的距离PAGEoffset
  812.                  printPAGEheight printPAGEWidth          ;可打印页高;
  813.                  ;输出数据或表格时X方向的偏移量;
  814.                  OffsetPrintX
  815.                     
  816.                  printnum                  ;打印内容选择
  817.                  limitROWheight            ;限制行高limitrowheight须大于3.8mm
  818.                  swheight zjheight         ;首尾字高swheight 中间字高zjheight

  819.                  startpage                 ;本次输出的起始页数;
  820.                  curpage                   ;当前输出所在的页数;
  821.              )
  822.   
  823.   (c:ShowZWXFCRegInf)
  824.   
  825.   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  826.   ;;;主程序                     ;
  827.   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  828.   (if (and printnum (setq p (getpoint "\n输入表格左上角位置(回车退出):")))(progn

  829.     (ZWX::bgReset inPrintFile)
  830.    
  831.     (setvar "cmdecho" 0)
  832.     (command "undo" "control" "all" "undo" "be")
  833.     (setq oldos (getvar "osmode") oldl (getvar "clayer"))
  834.     (setvar "osmode" 0)(setvar "clayer" "0")

  835.     (setq a '(("layer" "数据" 7) ("layer" "表格" 5)
  836.               ("style" "FixText" "isocp.shx,chin2.shx")
  837.               ("style" "remark" "isocp.shx,fhztxt.shx")
  838.               ("style" "DATA" "simplex.shx,chin2.shx")
  839.              )
  840.           OffsetPrintX 15
  841.     )
  842.     (foreach b a
  843.       (if (not (tblsearch (car b) (cadr b)))
  844.         (cond
  845.           ((= "layer" (car b))
  846.             (command "layer" "n" (cadr b) "c" (caddr b) (caddr b) "")
  847.           )
  848.           ((= "style" (car b))
  849.             (command "style" (cadr b) (caddr b) 0 1 0 "" "")
  850.           )
  851.         )
  852.       )
  853.     )

  854.     (if (member "1" printnum)
  855.      (setq p (ZWX::bgpriCOVER p))
  856.     )

  857.     (if (and data_list (member "3" printnum)) (progn
  858.      (setq p (list p nil nil 3 t) startpage 3)
  859.      (foreach a data_list (progn
  860.        (cond
  861.          ((= 1 (car a));CQMJ_l
  862.            (setq p (ZWX::bgpriMJB (car p) (cadr a) "CQMJ" (nth 2 p) (nth 1 p) (nth 3 p) (nth 4 p) t t))
  863.          )
  864.          ((= 2 (car a));GYMJ_l
  865.            (setq p (ZWX::bgpriMJB (car p) (cadr a) "GYMJ" (nth 2 p) (nth 1 p) (nth 3 p) (nth 4 p) t t))
  866.          )
  867.          ((= 3 (car a));BZSM_l
  868.            (setq p (ZWX::bgpriRemark (car p) (cadr a) (nth 2 p) (nth 1 p) (nth 3 p) (nth 4 p))) ;(nth 3 p)
  869.          )
  870.        );(princ (nth 3 p))
  871.      ))
  872.      (command "insert" "FC_LUOKUAN" (list (+ (caar p) OffsetPrintX) (- (cadar p) (cadr p))) "" "" "")
  873.      ; "explode" (entlast)) ;插入落款

  874.      (setq a (nth 3 p)
  875.            p (ZWX::bgNextPage (car p))
  876.      
  877.            a (cond ((= 3 a) "3")
  878.                    ((= 4 a) "3,4")
  879.                    ((< 4 a) (strcat "3-" (itoa a)))
  880.                    (t "???")
  881.              )
  882.            XSGC a JSJG a
  883.      )

  884.      (ZWX::PutFCInf (list (list "XSGC" XSGC) (list "JSJG" JSJG)))
  885.     ))

  886.     (if (member "2" printnum)
  887.      (setq p (ZWX::bgpriLIST p))
  888.     )

  889.     (setvar "osmode" oldos)(setvar "clayer" oldl)
  890.     (command "undo" "e")(setvar "cmdecho" 1)
  891.   ))
  892.   (gc)
  893. ;;;  (princ)
  894. )


  895. (defun c:-a10 ( / a printnum)
  896.   (if (/= "" (setq printnum (getstring "\n [1.首页/2.目录/3.建筑面积表,共有面积表,步骤说明/4.完整报告]\n选择输出报告内容(可用逗号输入多项):")))
  897.       (progn
  898.     (if (= "4" printnum)(setq printnum "1,2,3,4"))
  899.     (setq printnum (ZWX::Split (strcat printnum ",") '(",") nil))
  900.     (c:printfcbg printnum nil "dwg" nil)
  901.   ))
  902.   (princ)
  903. )


  904. (defun c:a10 ( / dcl_id dwg-flname dwg-flpath datfile cgbfile printnum
  905.                  dwgfile
  906.                  selprintbg opendlg look_file
  907.              )
  908.   (defun selprintbg (in$)
  909.       (if (= "1" (get_tile "wzbg"))
  910.         (progn
  911.           (mode_tile "bgfm" 1)
  912.           (mode_tile "bgml" 1)
  913.           (mode_tile "bgjzb" 1)
  914.           (setq printnum '("1" "2" "3"))
  915.         )
  916.         (progn
  917.           (mode_tile "bgfm" 0)
  918.           (mode_tile "bgml" 0)
  919.           (mode_tile "bgjzb" 0)
  920.         )
  921.       )
  922.     (if (= 1 in$)
  923.        (if (= "1" (get_tile "wzbg"))
  924.           (setq printnum '("1" "2" "3"))
  925.        )
  926.        (progn
  927.           (setq printnum nil)
  928.           (if (= "1" (get_tile "bgjzb"))
  929.              (setq printnum (cons "3" printnum))
  930.           )
  931.           (if (= "1" (get_tile "bgml"))
  932.              (setq printnum (cons "2" printnum))
  933.           )
  934.           (if (= "1" (get_tile "bgfm"))
  935.              (setq printnum (cons "1" printnum))
  936.           )
  937.        )
  938.     )
  939.   )
  940.   (defun opendlg ($key / a a1 a2 a3)
  941.     (cond
  942.       ((= "opencgb" $key)(setq a1 "选择成果表文件(*.cgb)" a2 cgbfile a3 "cgb"))
  943.       ((= "opendat" $key)(setq a1 "选择房产信息文件(*.dat)" a2 datfile a3 "dat"))
  944.     )
  945.     (if (setq a (getfiled a1 a2 a3 2))
  946.       (progn
  947.       (cond
  948.       ((= "opencgb" $key)(setq cgbfile a) (set_tile "cgbfile" cgbfile))
  949.       ((= "opendat" $key)(setq datfile a) (set_tile "datfile" datfile))
  950.       )
  951.       )
  952.     )
  953.   )

  954.   (defun look_file (inFile /)
  955.     (if (findfile inFile)
  956.       (startapp "notepad.exe" inFile)
  957.       (alert (strcat "找不到该文件\n" inFile))
  958.     )
  959.   )
  960.    
  961.     (if (not (setq dcl_id (load_dialog "FCPriGrid.dcl")))(exit))
  962.     (if (not (new_dialog "dlg_FCMJBG" dcl_id))(exit))
  963.     (setq dwg-flname (getvar "dwgname") dwg-flpath (getvar "dwgprefix"))
  964.     (if (/= "\" (substr dwg-flpath (strlen dwg-flpath) 1))(setq dwg-flpath "\"))
  965.     (setq dwg-flname (strcat dwg-flpath dwg-flname)
  966.           datfile (strcat (substr dwg-flname 1 (- (strlen dwg-flname) 3)) "dat")
  967.           cgbfile (strcat (substr dwg-flname 1 (- (strlen dwg-flname) 3)) "cgb")
  968.     )
  969.     (setq printnum '("1" "2" "3"))
  970.     (set_tile "wzbg" "1")
  971.     (selprintbg 1)
  972.     (set_tile "datfile" datfile)
  973.     (set_tile "cgbfile" cgbfile)
  974.   
  975.     (action_tile "opendat"     "(opendlg $key)")
  976.     (action_tile "lookdatfile" "(look_file datfile)")
  977.     (action_tile "opencgb"     "(opendlg $key)")
  978.     (action_tile "lookcgbfile" "(look_file cgbfile)")
  979.     (action_tile "wzbg"        "(selprintbg 1)")
  980.     (action_tile "bgfm"        "(selprintbg 2)")
  981.     (action_tile "bgml"        "(selprintbg 3)")
  982.     (action_tile "bgjzb"       "(selprintbg 4)")
  983.     (action_tile "editcanshu"  "(Edit-InfSetFile nil)")
  984.     (action_tile "editmulu"    "(Edit-FCMJBG-SET nil)")
  985.     (action_tile "accept"      "(done_dialog 1)")
  986.     (action_tile "cencel"      "(done_dialog 0)")
  987.     (if (= 1 (start_dialog))(progn
  988. ;;;      (setq dwgfile (strcat (substr cgbfile 1 (- (strlen cgbfile) 3)) "dwg"))
  989.       (c:printfcbg printnum cgbfile "cgb" datfile)
  990.     ))
  991.   (princ)
  992. )

  993. (defun c:edit_cgb( / a cgb_filename)
  994.      (setq a (getvar "dwgname") b (getvar "dwgprefix")
  995.            a (substr a 1 (- (strlen a) 4))
  996.            cgb_filename (strcat b a ".cgb")
  997.      )
  998.   (if (setq a (open cgb_filename "a")) (progn
  999.     (princ "\nFENTAN-NUMBER=1" a)
  1000.     (princ "\nFENTAN-VER=7.0" a)
  1001.     (princ "\n" a)
  1002.     (close a)
  1003.   ))
  1004.   (startapp "notepad.exe" cgb_filename)
  1005.   (princ)
  1006. )
  1007.   [/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2007-1-16 14:02:14 | 显示全部楼层
偶运行了一下,有点问题,看来要自已动手才能丰衣足食
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2007-2-2 14:47:04 | 显示全部楼层
真是不错啊~~~
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

使用道具 举报

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

使用道具 举报

发表于 2007-9-9 22:06:06 | 显示全部楼层
好复杂,看不懂。但还是很佩服楼上的。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2008-6-27 06:32:07 | 显示全部楼层
应该很好
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2008-7-2 10:06:36 | 显示全部楼层
能不能直接做成一个文件,这样我们直接下载就好了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

使用道具 举报

发表于 2008-7-18 16:14:53 | 显示全部楼层
确实有点问题,需要改进!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2008-11-14 19:12:34 | 显示全部楼层
好长啊,看半天不懂
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2008-12-8 18:51:03 | 显示全部楼层
好长
搞什么用的
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

使用道具 举报

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

使用道具 举报

已领礼包: 9个

财富等级: 恭喜发财

发表于 2008-12-31 15:58:26 | 显示全部楼层
感觉好难,我都不敢尝试写这种!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

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

GMT+8, 2024-3-28 20:17 , Processed in 0.295411 second(s), 59 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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