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

zwx62504 · 发表于 2006-12-24 12:57:00

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

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

×

[FONT=courier new]
(if (not (member 'c:ShowZWXFCRegInf (atoms-family 0))) (exit))
(if (not (member 'Edit-InfSetFile (atoms-family 0))) (load "FCinfset.VLX"))
(if (not (member 'ZWX::GetFCInf (atoms-family 0)))(load "ioFCInf.fas"))
(defun ZWX::bgGetSet ( / a) ;设置参数
(setq a (ZWX::GetFCInf nil)
bgbh (cadr (assoc "BGBH" a)) jzmj (cadr (assoc "JZMJ" a))
fwzl (cadr (assoc "FWZL" a)) fwmc (cadr (assoc "FWMC" a))
wtdw (cadr (assoc "WTDW" a)) tfbh (cadr (assoc "TFBH" a))
zcc (cadr (assoc "ZCC" a)) clrq (cadr (assoc "CLRQ" a))
dxhtrq (cadr (assoc "DXHTRQ" a)) fcbl (cadr (assoc "FCBL" a))
dxbl (cadr (assoc "DXBL" a)) HANGJU (cadr (assoc "HANGJU" a))
CQorYSorJZ_MJ (cadr (assoc "CQORYSORJZ_MJ" a)) PAGEisROWorCOL (cadr (assoc "PAGEISROWORCOL" a))
PAGEOFFSET (cadr (assoc "PAGEOFFSET" a)) SWHEIGHT (cadr (assoc "SWHEIGHT" a))
ZTDX (cadr (assoc "ZTDX" a)) CHHTY (cadr (assoc "CHHTY" a))
ZYS (cadr (assoc "ZYS" a)) XSGC (cadr (assoc "XSGC" a))
JSJG (cadr (assoc "JSJG" a)) DXTYS (cadr (assoc "DXTYS" a))
GCPMTYS (cadr (assoc "GCPMTYS" a))
;指定纸张大小fixPAGESIZE;
fixPAGESIZE (cadr (assoc "PAGESIZE" a))
;纸张打印方向fixPAGEFX;
fixPAGEFX (cadr (assoc "PAGEFX" a))
;字体宽度比例是否可以任意设置ZTBLLimit;
ZTBLLimit (cadr (assoc "ZTBLLIMIT" a))
;最小宽度比例限制LimitValue;
LimitValue (cadr (assoc "LIMITVALUE" a))
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))
SWHEIGHT (if a a 3.5)
)
)
(defun ZWX::bgGetPage (col / size fx1)
;;若未指定页规格
(if (not (or (= "a3" pagesize) (= "a4" pagesize)))
(cond
((and (= 0 fixPAGESIZE) (= 0 fixPAGEFX))
(cond
((< 32 col) (setq size "a3" fx1 1))
((< 16 col) (setq size "a4" fx1 1))
(t (setq size "a4" fx1 2))
)
)
((and (= 0 fixPAGESIZE) (/= 0 fixPAGEFX))
(if (= 1 fixPAGEFX)
(cond
((< 32 col) (setq size "a3" fx1 1))
((< 16 col) (setq size "a4" fx1 1))
(t (setq size "a4" fx1 1))
)
(cond
((< 32 col) (setq size "a3" fx1 2))
((< 16 col) (setq size "a3" fx1 2))
(t (setq size "a4" fx1 2))
)
)
)
((and (/= 0 fixPAGESIZE) (= 0 fixPAGEFX))
(if (= 1 fixPAGESIZE)
(cond ;a4
((< 32 col) (setq size "a4" fx1 1))
((< 16 col) (setq size "a4" fx1 1))
(t (setq size "a4" fx1 2))
)
(cond ;a3
((< 32 col) (setq size "a3" fx1 1))
((< 16 col) (setq size "a3" fx1 2))
(t (setq size "a3" fx1 2))
)
)
)
(t
(setq size (nth (1- fixPAGESIZE) '("a4" "a3")) fx1 fixPAGEFX)
)
)
(if (= 0 fixPAGEFX)
(if (= "a4" pagesize)
(cond ;a4
((< 32 col) (setq size "a4" fx1 1))
((< 16 col) (setq size "a4" fx1 1))
(t (setq size "a4" fx1 2))
)
(cond ;a3
((< 32 col) (setq size "a3" fx1 1))
((< 16 col) (setq size "a3" fx1 2))
(t (setq size "a3" fx1 2))
)
)
(setq size pagesize fx1 fixPAGEFX)
)
)
(setq pagesize size fixPAGEFX fx1)
;页的大小
(if (= size "a4")
(progn
(setq insertEmptyPAGE "FCBG_EmptyPAGE_A4" FCBGFixHead "FCBG_FixHead_A4")
(if (= 1 fx1)
(setq insertEmptyPAGE (strcat insertEmptyPAGE "h")
PAGEwidth 297.0 PAGEheight 210.0 printPAGEheight 195.0 TableWidth 257.0 OffsetPrintX 20)
(setq PAGEwidth 210.0 PAGEheight 297.0 printPAGEheight 277.00 TableWidth 180.0 OffsetPrintX 15)
))
(progn
(setq insertEmptyPAGE "FCBG_EmptyPAGE_A3" FCBGFixHead "FCBG_FixHead_A3")
(if (= 1 fx1)
(setq insertEmptyPAGE (strcat insertEmptyPAGE "h")
PAGEwidth 420.0 PAGEheight 297.0 printPAGEheight 282.0 TableWidth 380.0 OffsetPrintX 20)
(setq PAGEwidth 297.0 PAGEheight 420.0 printPAGEheight 400.00 TableWidth 267.0 OffsetPrintX 15)
))
)
)
;插入块
(defun ZWX::bgInsertBlock (BlockName InsertPoint)
(command "insert" BlockName InsertPoint "" "" ""); "explode" (entlast))
)
;绘表格线
(defun ZWX::bgDrawLine (StartPoint EndPoint / ent)
(command "_line" StartPoint EndPoint ""
"chprop" (setq ent (entlast)) "" "c" "blue" "la" "表格" ""
)
ent
)
;输出表格中指定行数据
(defun ZWX::bgPriGridRowData (LeftTopPoint Offset RowData aColsWidth CurRow /
j
cellText CellWidth CellPoint
CellHeightest RowNum
isWrap
allCellInf
TextStyle zh
temp
)
;;;写行数据
(setq j 0
CellPoint (polar LeftTopPoint (* 1.5 pi) Offset)
CellHeightest 0
)
(foreach CellText RowData
(setq CellWidth (nth j aColsWidth)
isWrap (not (numberp (read CellText))) ;面积的数据不允许回绕(vl-string-search "." CellText)
j (1+ j)
TextStyle (if (= 0 CurRow) "FixText" "data")
zh (if (or (= 1 j) (= (length RowData) j)) swheight zjheight)
)
(setq temp (ZWX::bgprint1 CellWidth CellText CellPoint zh 0 TextStyle "mc" "white" "数据" isWrap)) ;首尾大号字
(if (< CellHeightest (cadr temp))(setq CellHeightest (cadr temp) RowNum (cadddr temp))) ;最大行高
(setq CellPoint (car temp) allCellInf (cons (cdr temp) allCellInf))
)
;当该行有绕行情况,则重新调整各数据的位置,以保证位于单元格的中心位置
(if (> RowNum 1)
(foreach temp allCellInf
(if (< (caddr temp) RowNum)
(command "move" (cadr temp) "" "0,0,0" (strcat "@0," (rtos (/ (- (car temp) CellHeightest) 2))))
)
)
)
CellHeightest
)
(defun ZWX::bgOrientPage (InsertPoint insertOffSet insertFixHead aPageSize /
X1 y1 P1 P2 P3 an
)
(ZWX::bgInsertBlock insertEmptyPAGE InsertPoint);页
(setq X1 (car InsertPoint) y1 (cadr InsertPoint)
p1 (list (+ (car InsertPoint) 33.5563) (- (cadr InsertPoint) 32.17894))
p2 (list (+ (car InsertPoint) 166.6342) (- (cadr InsertPoint) 32.17894))
p3 (if (= 2 fixPAGEFX) (list (+ (car InsertPoint) 183.315) (- (cadr InsertPoint) 14.778))
(list (+ (car InsertPoint) 12.778) (- (cadr InsertPoint) 24.4))
)
an (if (= 2 fixPAGEFX) 0 90)
)
(if insertFixHead
(progn
(if insertFixHead (ZWX::bgInsertBlock FCBGFixHead InsertPoint))
;写坐落
(setq i 0)
(while (and (< i (strlen ZCC)) (setq a (substr ZCC (setq i (1+ i)))) (not (numberp (setq bb (read a))))))
(cond
((= "" ZCC)(setq bb ""))
((and (/= "" ZCC) (= "" bb))(setq bb "1"))
((and (/= "" ZCC) (not (numberp bb)))(setq bb "1"))
(t (setq bb (itoa bb)))
)
(IF (= aPageSize "a4")
(setq a (ZWX::bgprint1 55 FWZL P1 3.5 0 "data" "bl" "white" "数据" nil)
a (ZWX::bgprint1 20 bb P2 3.5 0 "data" "bl" "white" "数据" nil)
)
(setq a (ZWX::bgprint1 55 FWZL P1 3.5 0 "data" "bl" "white" "数据" nil)
a (ZWX::bgprint1 20 bb P2 3.5 0 "data" "bl" "white" "数据" nil)
)
)
)
)
;打印页码
(IF (= aPageSize "a4")
(setq a (ZWX::bgprint1 3.7 (itoa page2) P3 2.5 an "data" "mc" "white" "数据" nil))
(setq a (ZWX::bgprint1 3.7 (itoa page2) P3 2.5 an "data" "mc" "white" "数据" nil))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;子程序
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;----------------ZWX::bgReadCGB------------------------------------------
(defun ZWX::bgRtos (data / a re)
(mapcar '(lambda (a) (rtos a 2 3)) data)
)
(defun ZWX::bgSave1(l1 / a b
l2 head
xj hj ixj ihj ;小计xj 合计hj;
xjorhj i
)
(if (< oldLX 3)(progn
(setq ixj 0 ihj 0 l1 (reverse l1) head (car l1))
(while (setq a (car l1))
(cond
((and (or (= "==xj" a) (= "==hj" a))
(< 1 ixj)
)
(setq b (ZWX::bgRtos (if (= "==xj" a) xj hj))
b (append (if (= "==xj" a) '(("小计" "-")) '(("合计" "-"))) (cddr b))
l2 (cons b l2)
re$ (cons (cons oldLX (list (reverse l2))) re$)
l2 (list head)
xjorhj t i 0
)
(if (= "==xj" a) (setq xj nil ixj 0 ) (setq hj nil ihj 0))
(if (not (and (setq a (cadr l1))
(setq a (substr a 1 3))
(or (= "==n" a) (= "==p" a))
)
)
(setq re$ (cons '(3 . ("==n")) re$))
)
)
;;; (setq xj (ZWX::bgRtos xj)
;;; xj (append '(("小计" "-")) (cddr xj))
;;; l2 (cons xj l2)
;;; re$ (cons (cons oldLX (list (reverse l2))) re$)
;;; re$ (cons '(3 . ("==n")) re$)
;;; xj nil ixj 0 l2 (list head)
;;; )
;;; ((and (= "==hj" a) (< 1 ixj))
;;; (setq hj (ZWX::bgRtos hj)
;;; hj (append '(("合计" "-")) (cddr hj))
;;; l2 (cons hj l2)
;;; re$ (cons (cons oldLX (list (reverse l2))) re$)
;;; re$ (cons '(3 . ("==n")) re$)
;;; hj nil ihj 0 l2 nil
;;; )
;;; )
((or (= "==n" (substr a 1 3))
(= "==p" (substr a 1 3))
)
(if (not xjorhj) (setq l2 nil))
(setq re$ (cons (cons 3 (list a)) re$))
)
(t
;表格数据字段数小于最大个数应以空格字符补齐;
(setq b (length a))
(if (> LenRow b)
(setq b (vlax-make-safearray vlax-vbString (cons 0 (- LenRow b)))
b (vlax-safearray->list b)
a (append a b) ;空格字符后位补齐;
)
)
;小计和合计;
(setq l2 (cons a l2)
b (mapcar 'atof a)
xj (if (= 0 ixj) b (mapcar '+ xj b))
hj (if (= 0 ihj) b (mapcar '+ hj b))
ixj (1+ ixj)
ihj (1+ ihj)
)
)
)
(setq l1 (cdr l1))
(if xjorhj (if (= 1 i) (setq xjorhj nil i 0) (setq i (1+ i))))
)
(if l2 (cons (cons oldLX (list (reverse l2))) re$))
)
(cons (cons oldLX (list (reverse l1))) re$)
)
)
(defun ZWX::bgReadCGB (_fn /
line line1 f$ re$ FCVer Save
count a b
dataLX oldLX ;数据类型;
fixGS ;格式符类型 1==xj 2==hj 3 ==n 4==p
ll
LenRow
l$ l2
)
(setq dataLX 3 count 0)
(if (setq f$ (open _fn "r")) (progn
(while (setq line (read-line f$))
(cond
((or (= " " line) (= "" line)))
((wcmatch (strcase line) "FENTAN-NUMBER*")(setq ll nil))
(t (setq ll (cons line ll)))
)
)(close f$)
(foreach line (reverse ll)
(setq fixGS 0)
(cond
((not line)(setq line nil fixGS 3))
((= "" (vl-string-trim " " line))(setq line "==n" fixGS 3))
((= "==xj" line)(setq fixGS 1))
((= "==hj" line)(setq fixGS 2))
((= "==n" (substr line 1 3))(setq fixGS 3))
((= "==p" (substr line 1 3))(setq fixGS 4))
((wcmatch line "FENTAN-VER=*")
(setq a (ZWX::Split line (list "=") nil)
l$ nil re$ nil old$ 3
FCVer (if (cadr a) (atof (cadr a)) 0)
)
)
((or (= "fentan-jzshuju" line)
(= "==tn" line)
(and (< FCVer 7) (= "房号" (substr line 1 4))))
(setq dataLX 1 count 0 Save t LenRow 0 ixj 0 ihj 0)
)
((or (= "fentan-gyshuju" line)
(= "==gy" line)
(and (< FCVer 7) (= "项目" (substr line 1 4))))
(setq dataLX 2 count 0 Save t LenRow 0 ixj 0 ihj 0)
)
((or (= "fentan-bzsm" line) (= "==sm" line))
(setq dataLX 3 count 0 Save t)
)
)
(if (and Save l$)
(setq re$ (ZWX::bgSave1 l$) l$ nil)
)
(cond
((not line))
((= "" line))
((member line '("==tn" "==gy" "==sm")))
((= "fentan-" (strcase (substr line 1 7) t)))
((= 3 dataLX)
(cond
((= 1 fixGS))
((= 2 fixGS))
(t (setq l$ (cons line l$)))
)
)
(t
(cond
((< 0 fixGS)(setq l$ (cons line l$)))
(t
(setq a (ZWX::Split line (list (chr 9)) nil)
l$ (cons a l$)
a (length a)
LenRow (if (< LenRow a) a LenRow)
)
)
)
)
)
(setq oldLX dataLX count (1+ count))
(if (and (< dataLX 3) (< FCVer 7) (= "合计" (substr line 1 4)))
(setq Save t dataLX 3)
(setq Save nil)
)
) ;foreach
(if l$ (setq re$ (ZWX::bgSave1 l$) l$ nil))
(setq re$ (reverse re$))
) )
;;; (princ re$)
)
;是否允许多行打印PermitWrap
;
(defun ZWX::bgprint1 (_collen _text _Leftcoor _height angle1 _style _Justify _color _layer PermitWrap /
_position jianxu
entg Text1 Text2 i a b c
LL RL aWidth
newText newWidth
bRowHeight
len1
SSText
)
(setq Text1 (if (= "—" _text) "-" _text)
i (strlen Text1)
entg (list (cons 7 _style) ;字体类型
(cons 40 _height) ;高度
)
aWidth 1
Text2 Text1
jianxu 1.2
)
;(textbox '((1 . "层次:") (7 . "HZTXT") (41 . 0.85) (40 . 3.5)))
(while (and PermitWrap (< 1 i))
(setq a (substr Text1 1 i)
Text2 (substr Text1 (1+ i))
b (textbox (append (list (cons 1 a)) entg))
LL (caar b)
RL (caadr b)
aWidth (- RL LL)
aWidth (if (equal 0 aWidth 0) 1 (/ (- _collen jianxu jianxu) aWidth))
)
(if (< aWidth 0.6)
(setq i (if (> (ascii a) 128) (- i 2) (1- i)))
(progn
(if (< 1 aWidth)(setq aWidth 1))
(setq newText (cons a newText)
newWidth (cons aWidth newWidth)
Text1 (substr Text1 (1+ i))
i (strlen Text1)
)
)
)
)
(if (/= "" Text2)
(setq newText (cons Text2 newText)
newWidth (cons aWidth newWidth)
)
)
(setq newText (reverse newText)
newWidth (reverse newWidth)
bRowHeight 0
SSText (ssadd)
i 0
)
;jianxu 字与边界的间隙
;text字的内容,col输入所在列数,collen当前列的列宽,Leftcoor当前列的最左坐标,
(cond
((wcmatch _Justify "*l*")(setq _position _Leftcoor))
((wcmatch _Justify "*c*")(setq _position (polar _Leftcoor 0 (/ _collen 2.000))))
((wcmatch _Justify "*r*")(setq _position (polar _Leftcoor 0 _collen)))
)
(if (= 2 (length _position))(setq _position (append _position '(0))))
(foreach a newText
(command "text" "s" _style "j" _Justify _position _height angle1 a
"chprop" (entlast) "" "c" _color "la" _layer ""
)
(setq b (entget (entlast))
a (* 0.8 (if (= "-" a) 2 (nth i newWidth)))
b (subst (cons 41 a) (assoc 41 b) b)
_position (polar _position (* 1.5 pi) (+ 0.2 _height))
bRowHeight (+ bRowHeight (if (> i 0) 0.2 0) _height)
SSText (ssadd (entlast) SSText)
i (1+ i)
)
(entmod b)
)
;返回下一个输出点及当前本行的高度
(list (polar _Leftcoor 0 _collen) bRowHeight SSText i)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ZWX::bgNextPage (thepagepoint / _nextpagepoint)
(if (= PAGEisROWorCOL "0") ;各页为横向排列或竖向排列
(setq _nextpagepoint (polar thepagepoint 0 (+ PAGEoffset PAGEwidth))) ;横向
(setq _nextpagepoint (polar thepagepoint (* 1.5 pi) (+ PAGEoffset PAGEheight))) ;竖向
)
_nextpagepoint
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;封面
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ZWX::bgpriCOVER (cover_p / _a _b _c _p)
(setq PAGEwidth 210.0 PAGEheight 297.0 printPAGEheight 267.69
_a (list BGBH FWZL TFBH FWMC WTDW "三明市测量队" CLRQ)
_p (list (+ (car cover_p) 76.32518) (- (cadr cover_p) 143.29072))
)
(command "insert" "FCBG_COVER1" cover_p "" "" ""); "explode" (entlast)) ;封面1
(foreach _b _a (progn
(if (= "" _b)(setq _b "?????"))
(setq _c (ZWX::bgprint1 80 _b _p 3.5 0 "DATA" "mc" "white" "数据" nil)
_p (polar _p (* 1.5 pi) 8)
)
))
(setq cover_p (ZWX::bgNextPage cover_p))
(command "insert" "FCBG_COVER2" cover_p "" "" ""); "explode" (entlast)) ;;封面2
(setq cover_p (ZWX::bgNextPage cover_p))
cover_p
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;目录
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ZWX::bgpriLIST (LIST_p / _a _b _c _d _e _p)
;ZYS XSGC JSJG DXTYS GCPMTYS
(if (or (not ZYS) (= "" ZYS))(setq ZYS "???"))
(if (or (not XSGC) (= "" XSGC))(setq XSGC "无"))
(if (or (not JSJG) (= "" JSJG))(setq JSJG "无"))
(if (or (not DXTYS) (= "" DXTYS))(setq DXTYS "???"))
(if (or (not GCPMTYS) (= "" GCPMTYS))(setq GCPMTYS "???"))
(setq PAGEwidth 210.0 PAGEheight 297.0 printPAGEheight 267.69)
(command "insert" "FCBG_LIST1" LIST_p "" "" ""); "explode" (entlast))
(setq _c (ZWX::bgprint1 5.7 ZYS (list (+ (car LIST_p) 101.5567) (- (cadr LIST_p) 65.34037)) 3 0 "DATA" "c" "white" "数据" nil)
_c (ZWX::bgprint1 5.7 XSGC (list (+ (car LIST_p) 165.5954) (- (cadr LIST_p) 107.2063)) 3 0 "DATA" "c" "white" "数据" nil)
_c (ZWX::bgprint1 5.7 JSJG (list (+ (car LIST_p) 165.5954) (- (cadr LIST_p) 115.2063)) 3 0 "DATA" "c" "white" "数据" nil)
_c (ZWX::bgprint1 5.7 DXTYS (list (+ (car LIST_p) 165.5954) (- (cadr LIST_p) 123.2063)) 3 0 "DATA" "c" "white" "数据" nil)
_c (ZWX::bgprint1 5.7 GCPMTYS (list (+ (car LIST_p) 165.5954) (- (cadr LIST_p) 131.2063)) 3 0 "DATA" "c" "white" "数据" nil)
)
(ZWX::bgNextPage LIST_p)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;页面左上角定位点_p,输出数据表print_l,为产权或共有CQMJorGYMJ,页面A3或A4规格pagesize
;;;面积表格插入点对页定位点Y偏量old_Offset_Table 开始页数priPage
;;;是否插入新页NewPage 表格跨页时输出次页起面积表格是否含表头haveHEADAfterFirstPage
;;;首页是否插入固定页头insertFixHead
;;;
(defun ZWX::bgpriMJB (_p print_l CQMJorGYMJ pagesize old_Offset_Table priPage NewPage haveHEADAfterFirstPage insertFixHead /
a b c e f g i j aa bb b1 c1 i1 d1 startft page2
Offset_Table
CurRowNum ;当前页累计行数
CountRow ;总累计行数
PrintRow ;当前打印行数
Head collen_l ;列宽表
insertEmptyPAGE FCBGFixHead;插入空页面积计算表头
headheight ;当前行离建筑面积表格左上角的高度
RowestLine LeftestLine;表头最下一条横线RowestLine,表最左边直线LeftestLine
allColHeight ;本行的所有各列的高度
AllExEnts ;本行的所有竖线
firstRowestLineP1 firstRowestLineP2;首行下横线
firstRowestLineP3 firstRowestLineP4
rowheight ;当前行度
TableWidth ;表格宽度
sheight ;当前行累计高度
p_table p_line
blank
collenleft collenright ;列宽头和尾
drawline_l
computepoint ;表示是否计算过到达该页可打印的最底下的边界;
)
(setq Offset_Table old_Offset_Table
head (car print_l)
page2 priPage
headheight 0
)
(if print_l (progn
(if _p (progn
(ZWX::bgGetPage (length head))
;;;
;;;构建各列的列宽表collen_l
;正常打印宽度为180,最大打印宽度为195
;当按正常打印宽度180计算各数据列宽度小于10.2时,则按最大打印宽度195重新计算数据列度
;当数据列宽度大于17.7时,则将所有列的宽度按等份算
;
(setq
b 0 c 0 e nil
)
;预先设置固定字段宽度
(if (= "CQMJ" CQMJorGYMJ)
(foreach a head
(setq d nil)
(cond ((= "房号" a) (setq d 13.7))
((= "层次" a) (setq d 10.2))
((= "开间" a) (setq d 15.1))
((= "套内" a) (setq d 15.1))
((= "建筑面积" a) (setq d 17.7))
)
(if d (setq b (1+ b) ;固定字段个数
c (+ c d) ;固定字段总宽度
e (cons (cons a d) e) ;保存固定字段的宽度
)
)
)
)
;计算其余数据列宽度
(setq d (/ (- TableWidth c) (- (length head) b))) ;数据列的度
;若其余数据列宽度过大或过小则调整其宽度
(cond
((< d 10.2) ;过小
(setq TableWidth (+ TableWidth 15.0) ;修改表格宽度
d (/ (- TableWidth c) (- (length head) b)) ;修改数据列的宽度
OffsetPrintX 7.5 ;修改表格的横向偏移量
)
)
((>= d 17.7) ;过大
(setq d (/ TableWidth (length head))) ;修改所有列的宽度
(if (>= d 40) (setq d 35 TableWidth (* (length head) d)))
(foreach a e
(setq e (subst (cons (car a) d) a e))
)
)
)
;最后的列宽表collen_l
(foreach a head
(setq b (if (setq c (assoc a e)) (cdr c) d)
collen_l (cons b collen_l)
)
(if (= "CQMJ" CQMJorGYMJ)
(cond
((= "开间" a) (setq head (subst "套内使用及套内墙体建面和" a head)))
((= "阳台" a) (setq head (subst "阳台建面" a head)))
((= "半封阳台" a) (setq head (subst "半封阳台建面" a head)))
((= "未封阳台" a) (setq head (subst "未封阳台建面" a head)))
((= "非封阳台" a) (setq head (subst "非封阳台建面" a head)))
((= "全封阳台" a) (setq head (subst "全封阳台建面" a head)))
((= "封闭阳台" a) (setq head (subst "封闭阳台建面" a head)))
((= "套内" a) (setq head (subst "套内建筑面积" a head)))
)
)
)
;;;参数初始化
(setq collen_l (reverse collen_l)
print_l (subst head (car print_l) print_l)
CountRow 0 CurRowNum 0 sheight 0
)
(while (< CountRow (length print_l)) (progn
(if (= 0 CurRowNum) (progn
(if NewPage (progn
;放样新空白页和表格
(command "zoom" "w" _p (list (+ (car _p) PAGEwidth) (- (cadr _p) PAGEheight) 0))
;(InsertPoint insertOffSet insertFixHead aPageSize
(ZWX::bgOrientPage _p Offset_Table (= startpage page2) PageSize)
));(if NewPage
(if (or (not old_Offset_Table) (> 20 old_Offset_Table))
(if (and insertFixHead (= startpage page2))
;当首页且需要插入固定页头时Offset_Table=34.5
(setq Offset_Table 34.5) ;首页
(setq Offset_Table 20) ;其他页
)
)
(setq p_table (list (+ (car _p) OffsetPrintX) (- (cadr _p) Offset_Table) 0)) ;插入表格位置
;绘表格最顶及最左边的一条线
(setq RowestLine (ZWX::bgDrawLine p_table (strcat "@" (rtos TableWidth) "<0"))
f p_table
)
;用offset绘出所有的竖线并将所有的竖线保存于AllExEnts
(foreach a (append '(0) collen_l)
(setq f (polar f 0 a) ;竖线上端点
c (polar f (* 1.5 pi) 1) ;竖线下端点
LeftestLine (ZWX::bgDrawLine f c) ;开始画线
AllExEnts (cons (list LeftestLine c) AllExEnts) ;保存所有竖线
)
)
));(if (= 0 CurRowNum) (progn
;每页表格是否输出该表格的第一行数据
(if (and (= 0 CurRowNum) (< priPage page2) haveHEADAfterFirstPage)
(setq i 0 CountRow (1- CountRow)) ;FixText
(setq i CountRow)
)
(setq rowheight limitrowheight
aa (nth i print_l)
;;;写行据(ZWX::bgPriGridRowData LeftTopPoint Offset RowData aColsWidth)
allColHeight (ZWX::bgPriGridRowData p_table (+ sheight (/ rowheight 2)) aa collen_l i)
rowheight (+ (* swheight HANGJU) allColHeight)
sheight (+ sheight rowheight)
f (polar p_table (* 1.5 pi) sheight)
;;;绘当前行的下线
RowestLine (ZWX::bgDrawLine f (strcat "@" (rtos TableWidth) "<0"))
CurRowNum (1+ CurRowNum)
computepoint nil
)
;;;若下一行超出打印范围则须插入新的一页
(if (< printPAGEheight (+ Offset_Table sheight limitrowheight headheight))
(setq CurRowNum 0
_p (ZWX::bgNextPage _p)
NewPage t old_Offset_Table nil page2 (1+ page2)
Offset_Table nil
computepoint t
)
)
(if (or (= 0 CurRowNum) (= (1+ CountRow) (length print_l)))(progn ;(equal aa (last print_l))
;;;将当前表格的所有竖线拉伸至表格尾部
;;;创建选择集
(command "_extend" RowestLine "")
(foreach b1 AllExEnts (command b1))
(command "")
(if (and (not computepoint) (equal aa (last print_l)))
(setq p_table (polar p_table (* 1.5 pi) (+ headheight sheight 0.1))
Offset_Table (- (cadr _p) (cadr p_table))
)
)
(setq sheight 0 AllExEnts nil)
))
(setq CountRow (1+ CountRow) RowestLine nil)
))
;;; (princ (> pageheight (+ Offset_Table swheight)))
;;;返回当前报告页左上角点及产权面积表最下一横线标
(if (not computepoint)
(if (> pageheight (+ Offset_Table swheight))
(setq NewPage nil Offset_Table (+ Offset_Table swheight))
(setq NewPage t Offset_Table 25 page2 (1+ page2))
)
)
))
)(princ "\n没有可填写的记录,记录为空!"))
(list _p Offset_Table pagesize page2 NewPage)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;打印一般文字;;;;;;;;;;;;;;;;;;;;;;;
(defun ZWX::bgpriRemark (_p print_l pagesize old_Offset_Table priPage NewPage /
a b c e f g i j aa bb startft page2
Offset_Table
head
startft ;属分摊数据的开始位置
collen_l ;列宽表
;插入第三页的名称insertPAGEn3 插入建筑面积表格的名称inserttable
insertPAGEn3 insertPAGEn4 inserttable
headheight ;当前行离建筑面积表格左上角的高度
RowestLine ;表头最下一条横线
firstRowestLineP1 firstRowestLineP2;首行下横线
rowheight ;当前行高度
sheight ;当前行累计高度
p_table p_line
)
(setq Offset_Table old_Offset_Table page2 priPage)
(if print_l (progn
(if _p (progn
(ZWX::bgGetPage (length head))
;;;参数初始化
(setq g 0 sheight 0 rowheight (* 1.2 swheight))
(foreach aa print_l (progn
(if (= 0 g) (progn ;放样表格
(if NewPage (progn
(command "zoom" "w" _p (list (+ (car _p) PAGEwidth) (- (cadr _p) PAGEheight) 0))
(ZWX::bgOrientPage _p Offset_Table (= startpage page2) PageSize)
))
(if (not old_Offset_Table)
(if (= 3 page2)
(setq Offset_Table 34.5) ;首页
(setq Offset_Table 20) ;其他页
)
)
(setq p_table (polar _p (* 1.5 pi) Offset_Table))
));(if (= 0 g) (progn
;;;写行数据
(setq f (polar _p (* 1.5 pi) (+ Offset_Table sheight swheight)) ;(/ rowheight 2)
f (ZWX::bgprint1 (- pagewidth 30) aa (polar f 0 OffsetPrintX) swheight 0
"remark"
;(if (wcmatch aa "*÷*") "remark" "FixText")
"bl" "white" "数据" t
)
)
(setq g (1+ g) sheight (+ sheight rowheight))
;;;若下一行超出打印范围则须插入下一页
(if (< printPAGEheight (+ Offset_Table sheight))
(setq g 0 _p (ZWX::bgNextPage _p) NewPage t old_Offset_Table nil page2 (1+ page2))
)
(if (or (= 0 g) (eq aa (last print_l)))(progn
(if (eq aa (last print_l))
(setq p_table (polar p_table (* 1.5 pi) sheight)
Offset_Table (- (cadr _p) (cadr p_table))
)
)
(setq sheight 0)
))
))
;;;返回当前报告页左上角点及产权面积表最下一横线的坐标
(if (> printPAGEheight (+ Offset_Table swheight))
(setq NewPage nil Offset_Table (+ Offset_Table swheight))
(setq NewPage t Offset_Table 25 page2 (1+ page2))
)
))
))
(list _p Offset_Table pagesize page2 NewPage)
)
;
;
;
(defun ZWX::bgReset (inflname / a b dwg_flpath) ;设置参数
(if inflname
(setq cgb_filename (ZWX::FilebyExName inflname "cgb"))
(setq cgb_filename (Get-thisFileName "cgb"))
)
(ZWX::bgGetSet)
(setq data_list (ZWX::bgReadCGB cgb_filename)
HANGJU (atof HANGJU)
PAGEoffset (atof PAGEoffset)
zjheight (* swheight 0.8)
limitrowheight (+ swheight (* swheight HANGJU))
ver1 "7.0"
)
)
;参数包括;指定打印页printnum,打印文件inPrintFile,文件类型FileType(特指cgb或dwg文件)
(defun c:printfcbg (printnum inPrintFile FileType InfSetFile /
p oldos oldl ver1
data_list
bgbh jzmj fwzl fwmc wtdw tfbh zcc clrq dxhtrq fcbl dxbl
HANGJU CQorYSorJZ_MJ
ZTDX CHHTY
ZYS XSGC JSJG DXTYS GCPMTYS ;总页数ZYS 计算过程XSGC JSJG
fixPAGESIZE fixPAGEFX
ZTBLLimit LimitValue
cgb_filename
PAGEwidth PAGEheight ;页宽PAGEwidth 页高PAGEheight
PAGEisROWorCOL PAGEoffset ;各页为横向排列或竖向排列PAGEisROWorCOL 页与页之间的距离PAGEoffset
printPAGEheight printPAGEWidth ;可打印页高;
;输出数据或表格时X方向的偏移量;
OffsetPrintX
printnum ;打印内容选择
limitROWheight ;限制行高limitrowheight须大于3.8mm
swheight zjheight ;首尾字高swheight 中间字高zjheight
startpage ;本次输出的起始页数;
curpage ;当前输出所在的页数;
)
(c:ShowZWXFCRegInf)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;主程序 ;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (and printnum (setq p (getpoint "\n输入表格左上角位置(回车退出):")))(progn
(ZWX::bgReset inPrintFile)
(setvar "cmdecho" 0)
(command "undo" "control" "all" "undo" "be")
(setq oldos (getvar "osmode") oldl (getvar "clayer"))
(setvar "osmode" 0)(setvar "clayer" "0")
(setq a '(("layer" "数据" 7) ("layer" "表格" 5)
("style" "FixText" "isocp.shx,chin2.shx")
("style" "remark" "isocp.shx,fhztxt.shx")
("style" "DATA" "simplex.shx,chin2.shx")
)
OffsetPrintX 15
)
(foreach b a
(if (not (tblsearch (car b) (cadr b)))
(cond
((= "layer" (car b))
(command "layer" "n" (cadr b) "c" (caddr b) (caddr b) "")
)
((= "style" (car b))
(command "style" (cadr b) (caddr b) 0 1 0 "" "")
)
)
)
)
(if (member "1" printnum)
(setq p (ZWX::bgpriCOVER p))
)
(if (and data_list (member "3" printnum)) (progn
(setq p (list p nil nil 3 t) startpage 3)
(foreach a data_list (progn
(cond
((= 1 (car a));CQMJ_l
(setq p (ZWX::bgpriMJB (car p) (cadr a) "CQMJ" (nth 2 p) (nth 1 p) (nth 3 p) (nth 4 p) t t))
)
((= 2 (car a));GYMJ_l
(setq p (ZWX::bgpriMJB (car p) (cadr a) "GYMJ" (nth 2 p) (nth 1 p) (nth 3 p) (nth 4 p) t t))
)
((= 3 (car a));BZSM_l
(setq p (ZWX::bgpriRemark (car p) (cadr a) (nth 2 p) (nth 1 p) (nth 3 p) (nth 4 p))) ;(nth 3 p)
)
);(princ (nth 3 p))
))
(command "insert" "FC_LUOKUAN" (list (+ (caar p) OffsetPrintX) (- (cadar p) (cadr p))) "" "" "")
; "explode" (entlast)) ;插入落款
(setq a (nth 3 p)
p (ZWX::bgNextPage (car p))
a (cond ((= 3 a) "3")
((= 4 a) "3,4")
((< 4 a) (strcat "3-" (itoa a)))
(t "???")
)
XSGC a JSJG a
)
(ZWX::PutFCInf (list (list "XSGC" XSGC) (list "JSJG" JSJG)))
))
(if (member "2" printnum)
(setq p (ZWX::bgpriLIST p))
)
(setvar "osmode" oldos)(setvar "clayer" oldl)
(command "undo" "e")(setvar "cmdecho" 1)
))
(gc)
;;; (princ)
)
(defun c:-a10 ( / a printnum)
(if (/= "" (setq printnum (getstring "\n [1.首页/2.目录/3.建筑面积表,共有面积表,步骤说明/4.完整报告]\n选择输出报告内容(可用逗号输入多项):")))
(progn
(if (= "4" printnum)(setq printnum "1,2,3,4"))
(setq printnum (ZWX::Split (strcat printnum ",") '(",") nil))
(c:printfcbg printnum nil "dwg" nil)
))
(princ)
)
(defun c:a10 ( / dcl_id dwg-flname dwg-flpath datfile cgbfile printnum
dwgfile
selprintbg opendlg look_file
)
(defun selprintbg (in$)
(if (= "1" (get_tile "wzbg"))
(progn
(mode_tile "bgfm" 1)
(mode_tile "bgml" 1)
(mode_tile "bgjzb" 1)
(setq printnum '("1" "2" "3"))
)
(progn
(mode_tile "bgfm" 0)
(mode_tile "bgml" 0)
(mode_tile "bgjzb" 0)
)
)
(if (= 1 in$)
(if (= "1" (get_tile "wzbg"))
(setq printnum '("1" "2" "3"))
)
(progn
(setq printnum nil)
(if (= "1" (get_tile "bgjzb"))
(setq printnum (cons "3" printnum))
)
(if (= "1" (get_tile "bgml"))
(setq printnum (cons "2" printnum))
)
(if (= "1" (get_tile "bgfm"))
(setq printnum (cons "1" printnum))
)
)
)
)
(defun opendlg ($key / a a1 a2 a3)
(cond
((= "opencgb" $key)(setq a1 "选择成果表文件(*.cgb)" a2 cgbfile a3 "cgb"))
((= "opendat" $key)(setq a1 "选择房产信息文件(*.dat)" a2 datfile a3 "dat"))
)
(if (setq a (getfiled a1 a2 a3 2))
(progn
(cond
((= "opencgb" $key)(setq cgbfile a) (set_tile "cgbfile" cgbfile))
((= "opendat" $key)(setq datfile a) (set_tile "datfile" datfile))
)
)
)
)
(defun look_file (inFile /)
(if (findfile inFile)
(startapp "notepad.exe" inFile)
(alert (strcat "找不到该文件\n" inFile))
)
)
(if (not (setq dcl_id (load_dialog "FCPriGrid.dcl")))(exit))
(if (not (new_dialog "dlg_FCMJBG" dcl_id))(exit))
(setq dwg-flname (getvar "dwgname") dwg-flpath (getvar "dwgprefix"))
(if (/= "\" (substr dwg-flpath (strlen dwg-flpath) 1))(setq dwg-flpath "\"))
(setq dwg-flname (strcat dwg-flpath dwg-flname)
datfile (strcat (substr dwg-flname 1 (- (strlen dwg-flname) 3)) "dat")
cgbfile (strcat (substr dwg-flname 1 (- (strlen dwg-flname) 3)) "cgb")
)
(setq printnum '("1" "2" "3"))
(set_tile "wzbg" "1")
(selprintbg 1)
(set_tile "datfile" datfile)
(set_tile "cgbfile" cgbfile)
(action_tile "opendat" "(opendlg $key)")
(action_tile "lookdatfile" "(look_file datfile)")
(action_tile "opencgb" "(opendlg $key)")
(action_tile "lookcgbfile" "(look_file cgbfile)")
(action_tile "wzbg" "(selprintbg 1)")
(action_tile "bgfm" "(selprintbg 2)")
(action_tile "bgml" "(selprintbg 3)")
(action_tile "bgjzb" "(selprintbg 4)")
(action_tile "editcanshu" "(Edit-InfSetFile nil)")
(action_tile "editmulu" "(Edit-FCMJBG-SET nil)")
(action_tile "accept" "(done_dialog 1)")
(action_tile "cencel" "(done_dialog 0)")
(if (= 1 (start_dialog))(progn
;;; (setq dwgfile (strcat (substr cgbfile 1 (- (strlen cgbfile) 3)) "dwg"))
(c:printfcbg printnum cgbfile "cgb" datfile)
))
(princ)
)
(defun c:edit_cgb( / a cgb_filename)
(setq a (getvar "dwgname") b (getvar "dwgprefix")
a (substr a 1 (- (strlen a) 4))
cgb_filename (strcat b a ".cgb")
)
(if (setq a (open cgb_filename "a")) (progn
(princ "\nFENTAN-NUMBER=1" a)
(princ "\nFENTAN-VER=7.0" a)
(princ "\n" a)
(close a)
))
(startapp "notepad.exe" cgb_filename)
(princ)
)
[/FONT]

[FONT=courier new] 
(if (not (member 'c:ShowZWXFCRegInf (atoms-family 0))) (exit)) 
(if (not (member 'Edit-InfSetFile (atoms-family 0))) (load "FCinfset.VLX")) 
(if (not (member 'ZWX::GetFCInf (atoms-family 0)))(load "ioFCInf.fas")) 
 
  (defun ZWX::bgGetSet ( / a) ;设置参数 
    (setq a (ZWX::GetFCInf nil) 
          bgbh (cadr (assoc "BGBH" a))                   jzmj (cadr (assoc "JZMJ" a)) 
          fwzl (cadr (assoc "FWZL" a))                   fwmc (cadr (assoc "FWMC" a)) 
          wtdw (cadr (assoc "WTDW" a))                   tfbh (cadr (assoc "TFBH" a)) 
          zcc (cadr (assoc "ZCC" a))                     clrq (cadr (assoc "CLRQ" a)) 
          dxhtrq (cadr (assoc "DXHTRQ" a))               fcbl (cadr (assoc "FCBL" a)) 
          dxbl (cadr (assoc "DXBL" a))                   HANGJU (cadr (assoc "HANGJU" a)) 
          CQorYSorJZ_MJ (cadr (assoc "CQORYSORJZ_MJ" a)) PAGEisROWorCOL (cadr (assoc "PAGEISROWORCOL" a)) 
          PAGEOFFSET (cadr (assoc "PAGEOFFSET" a))       SWHEIGHT (cadr (assoc "SWHEIGHT" a)) 
          ZTDX (cadr (assoc "ZTDX" a))                   CHHTY (cadr (assoc "CHHTY" a)) 
          ZYS (cadr (assoc "ZYS" a))                     XSGC (cadr (assoc "XSGC" a)) 
          JSJG (cadr (assoc "JSJG" a))                   DXTYS (cadr (assoc "DXTYS" a)) 
          GCPMTYS (cadr (assoc "GCPMTYS" a)) 
 
          ;指定纸张大小fixPAGESIZE; 
          fixPAGESIZE (cadr (assoc "PAGESIZE" a)) 
          ;纸张打印方向fixPAGEFX; 
          fixPAGEFX (cadr (assoc "PAGEFX" a)) 
           
          ;字体宽度比例是否可以任意设置ZTBLLimit; 
          ZTBLLimit (cadr (assoc "ZTBLLIMIT" a)) 
          ;最小宽度比例限制LimitValue; 
          LimitValue (cadr (assoc "LIMITVALUE" a)) 
 
          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)) 
          SWHEIGHT (if a a 3.5) 
    ) 
  ) 
 
(defun ZWX::bgGetPage (col / size fx1) 
          ;;若未指定页规格 
      (if (not (or (= "a3" pagesize) (= "a4" pagesize))) 
         (cond 
          ((and (= 0 fixPAGESIZE) (= 0 fixPAGEFX)) 
            (cond 
              ((< 32 col) (setq size "a3" fx1 1)) 
              ((< 16 col) (setq size "a4" fx1 1)) 
              (t (setq size "a4" fx1 2)) 
            ) 
          ) 
          ((and (= 0 fixPAGESIZE) (/= 0 fixPAGEFX)) 
           (if (= 1 fixPAGEFX) 
            (cond 
              ((< 32 col) (setq size "a3" fx1 1)) 
              ((< 16 col) (setq size "a4" fx1 1)) 
              (t (setq size "a4" fx1 1)) 
            ) 
            (cond 
              ((< 32 col) (setq size "a3" fx1 2)) 
              ((< 16 col) (setq size "a3" fx1 2)) 
              (t (setq size "a4" fx1 2)) 
            ) 
           ) 
          ) 
          ((and (/= 0 fixPAGESIZE) (= 0 fixPAGEFX)) 
           (if (= 1 fixPAGESIZE) 
            (cond        ;a4 
              ((< 32 col) (setq size "a4" fx1 1)) 
              ((< 16 col) (setq size "a4" fx1 1)) 
              (t (setq size "a4" fx1 2)) 
            ) 
            (cond   ;a3 
              ((< 32 col) (setq size "a3" fx1 1)) 
              ((< 16 col) (setq size "a3" fx1 2)) 
              (t (setq size "a3" fx1 2)) 
            ) 
           ) 
          ) 
          (t 
            (setq size (nth (1- fixPAGESIZE) '("a4" "a3")) fx1 fixPAGEFX) 
          ) 
        ) 
 
        
        
        (if (= 0 fixPAGEFX) 
           (if (= "a4" pagesize) 
            (cond        ;a4 
              ((< 32 col) (setq size "a4" fx1 1)) 
              ((< 16 col) (setq size "a4" fx1 1)) 
              (t (setq size "a4" fx1 2)) 
            ) 
            (cond   ;a3 
              ((< 32 col) (setq size "a3" fx1 1)) 
              ((< 16 col) (setq size "a3" fx1 2)) 
              (t (setq size "a3" fx1 2)) 
            ) 
           ) 
          (setq size pagesize fx1 fixPAGEFX) 
         ) 
    )    
      (setq pagesize size fixPAGEFX fx1) 
      ;页的大小 
      (if (= size "a4") 
        (progn 
        (setq insertEmptyPAGE "FCBG_EmptyPAGE_A4" FCBGFixHead "FCBG_FixHead_A4") 
        (if (= 1 fx1) 
        (setq insertEmptyPAGE (strcat insertEmptyPAGE "h") 
              PAGEwidth 297.0 PAGEheight 210.0 printPAGEheight 195.0 TableWidth 257.0 OffsetPrintX 20) 
        (setq PAGEwidth 210.0 PAGEheight 297.0 printPAGEheight 277.00 TableWidth 180.0 OffsetPrintX 15) 
        )) 
        (progn 
        (setq insertEmptyPAGE "FCBG_EmptyPAGE_A3" FCBGFixHead "FCBG_FixHead_A3") 
        (if (= 1 fx1) 
        (setq insertEmptyPAGE (strcat insertEmptyPAGE "h") 
              PAGEwidth 420.0 PAGEheight 297.0 printPAGEheight 282.0 TableWidth 380.0 OffsetPrintX 20) 
        (setq PAGEwidth 297.0 PAGEheight 420.0 printPAGEheight 400.00 TableWidth 267.0 OffsetPrintX 15) 
        )) 
      ) 
  ) 
 
  ;插入块 
  (defun ZWX::bgInsertBlock (BlockName InsertPoint) 
    (command "insert" BlockName InsertPoint "" "" ""); "explode" (entlast)) 
  ) 
 
  ;绘表格线 
  (defun ZWX::bgDrawLine (StartPoint EndPoint / ent) 
    (command "_line" StartPoint EndPoint "" 
             "chprop" (setq ent (entlast)) "" "c" "blue" "la" "表格" "" 
    ) 
    ent 
  ) 
 
  ;输出表格中指定行数据 
  (defun ZWX::bgPriGridRowData (LeftTopPoint Offset RowData aColsWidth CurRow / 
                       j 
                       cellText CellWidth CellPoint 
                       CellHeightest RowNum 
                       isWrap 
                       allCellInf 
                       TextStyle zh 
                       temp 
                      ) 
        ;;;写行数据 
        (setq j 0 
              CellPoint (polar LeftTopPoint (* 1.5 pi) Offset) 
              CellHeightest 0 
        ) 
        (foreach CellText RowData 
          (setq CellWidth (nth j aColsWidth) 
                isWrap (not (numberp (read CellText)))  ;面积的数据不允许回绕(vl-string-search "." CellText) 
                j (1+ j) 
                TextStyle (if (= 0 CurRow) "FixText" "data") 
                zh (if (or (= 1 j) (= (length RowData) j)) swheight zjheight) 
          ) 
           
          (setq temp (ZWX::bgprint1 CellWidth CellText CellPoint zh 0 TextStyle "mc" "white" "数据" isWrap)) ;首尾大号字 
          (if (< CellHeightest (cadr temp))(setq CellHeightest (cadr temp) RowNum (cadddr temp)))  ;最大行高 
          (setq CellPoint (car temp) allCellInf (cons (cdr temp) allCellInf)) 
        ) 
 
        ;当该行有绕行情况,则重新调整各数据的位置,以保证位于单元格的中心位置 
        (if (> RowNum 1) 
          (foreach temp allCellInf 
            (if (< (caddr temp) RowNum) 
              (command "move" (cadr temp) "" "0,0,0" (strcat "@0," (rtos (/ (- (car temp) CellHeightest) 2)))) 
            ) 
          ) 
        ) 
    CellHeightest 
  ) 
 
(defun ZWX::bgOrientPage (InsertPoint insertOffSet insertFixHead aPageSize / 
                           X1 y1 P1 P2 P3 an 
                          ) 
           (ZWX::bgInsertBlock insertEmptyPAGE InsertPoint);页 
           
           (setq X1 (car InsertPoint) y1 (cadr InsertPoint) 
                 p1 (list (+ (car InsertPoint) 33.5563) (- (cadr InsertPoint) 32.17894)) 
                 p2 (list (+ (car InsertPoint) 166.6342) (- (cadr InsertPoint) 32.17894)) 
                 p3 (if (= 2 fixPAGEFX) (list (+ (car InsertPoint) 183.315) (- (cadr InsertPoint) 14.778)) 
                                        (list (+ (car InsertPoint) 12.778) (- (cadr InsertPoint) 24.4)) 
                    ) 
                 an (if (= 2 fixPAGEFX) 0 90) 
           ) 
   
           (if insertFixHead 
             (progn 
               (if insertFixHead (ZWX::bgInsertBlock FCBGFixHead InsertPoint)) 
                  
               ;写坐落 
               (setq i 0) 
               (while (and (
               (cond 
                  ((= "" ZCC)(setq bb "")) 
                  ((and (/= "" ZCC) (= "" bb))(setq bb "1")) 
                  ((and (/= "" ZCC) (not (numberp bb)))(setq bb "1")) 
                  (t (setq bb (itoa bb))) 
               ) 
               (IF (= aPageSize "a4") 
                 (setq a (ZWX::bgprint1 55 FWZL P1 3.5 0 "data" "bl" "white" "数据" nil) 
                       a (ZWX::bgprint1 20 bb P2 3.5 0 "data" "bl" "white" "数据" nil) 
                 ) 
                 (setq a (ZWX::bgprint1 55 FWZL P1 3.5 0 "data" "bl" "white" "数据" nil) 
                       a (ZWX::bgprint1 20 bb P2 3.5 0 "data" "bl" "white" "数据" nil) 
                 ) 
               ) 
             ) 
           ) 
 
           ;打印页码 
           (IF (= aPageSize "a4") 
             (setq a (ZWX::bgprint1 3.7 (itoa page2) P3 2.5 an "data" "mc" "white" "数据" nil)) 
             (setq a (ZWX::bgprint1 3.7 (itoa page2) P3 2.5 an "data" "mc" "white" "数据" nil)) 
           ) 
) 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;;子程序 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;;----------------ZWX::bgReadCGB------------------------------------------ 
(defun ZWX::bgRtos (data / a re) 
  (mapcar '(lambda (a) (rtos a 2 3)) data) 
) 
 
(defun ZWX::bgSave1(l1 / a b 
                         l2 head 
                         xj hj ixj ihj  ;小计xj 合计hj; 
                    xjorhj i 
                   ) 
  (if (< oldLX 3)(progn 
    (setq ixj 0 ihj 0 l1 (reverse l1) head (car l1)) 
    (while (setq a (car l1)) 
      (cond 
        ((and (or (= "==xj" a) (= "==hj" a)) 
              (< 1 ixj) 
         ) 
          (setq b (ZWX::bgRtos (if (= "==xj" a) xj hj)) 
                b (append (if (= "==xj" a) '(("小计" "-")) '(("合计" "-"))) (cddr b)) 
                l2 (cons b l2) 
                re$ (cons (cons oldLX (list (reverse l2))) re$) 
                l2 (list head) 
                xjorhj t i 0 
          ) 
          (if (= "==xj" a) (setq xj nil ixj 0 ) (setq hj nil ihj 0)) 
          (if (not (and (setq a (cadr l1)) 
                        (setq a (substr a 1 3)) 
                        (or (= "==n" a) (= "==p" a)) 
                   ) 
              ) 
            (setq re$ (cons '(3 . ("==n")) re$)) 
          ) 
        ) 
 
         ;;;          (setq xj (ZWX::bgRtos xj) 
;;;                xj (append '(("小计" "-")) (cddr xj)) 
;;;                l2 (cons xj l2) 
;;;                re$ (cons (cons oldLX (list (reverse l2))) re$) 
;;;                re$ (cons '(3 . ("==n")) re$) 
;;;                xj nil ixj 0 l2 (list head) 
;;;          ) 
;;;        ((and (= "==hj" a) (< 1 ixj)) 
;;;          (setq hj (ZWX::bgRtos hj) 
;;;                hj (append '(("合计" "-")) (cddr hj)) 
;;;                l2 (cons hj l2) 
;;;                re$ (cons (cons oldLX (list (reverse l2))) re$) 
;;;                re$ (cons '(3 . ("==n")) re$) 
;;;                hj nil ihj 0 l2 nil 
;;;          ) 
;;;        ) 
        ((or (= "==n" (substr a 1 3)) 
             (= "==p" (substr a 1 3)) 
         ) 
           (if (not xjorhj) (setq l2 nil)) 
           (setq re$ (cons (cons 3 (list a)) re$)) 
        ) 
        (t 
          ;表格数据字段数小于最大个数应以空格字符补齐; 
          (setq b (length a)) 
          (if (> LenRow b) 
            (setq b (vlax-make-safearray vlax-vbString (cons 0 (- LenRow b))) 
                  b (vlax-safearray->list b)   
                  a (append a b)  ;空格字符后位补齐; 
            ) 
          ) 
         ;小计和合计; 
          (setq l2 (cons a l2) 
 
                b (mapcar 'atof a) 
                xj (if (= 0 ixj) b (mapcar '+ xj b)) 
                hj (if (= 0 ihj) b (mapcar '+ hj b)) 
                ixj (1+ ixj) 
                ihj (1+ ihj) 
          ) 
        ) 
      ) 
      (setq l1 (cdr l1)) 
 
      (if xjorhj (if (= 1 i) (setq xjorhj nil i 0) (setq i (1+ i)))) 
    ) 
    
    (if l2 (cons (cons oldLX (list (reverse l2))) re$)) 
  ) 
    (cons (cons oldLX (list (reverse l1))) re$) 
  ) 
   
) 
 
  (defun ZWX::bgReadCGB (_fn / 
                         line line1 f$  re$ FCVer Save 
                         count a b 
                         dataLX oldLX ;数据类型; 
                         fixGS   ;格式符类型 1==xj 2==hj 3 ==n 4==p 
                         ll 
                         LenRow 
 
                         l$ l2 
                          
                        ) 
    (setq dataLX 3 count 0) 
    (if        (setq f$ (open _fn "r")) (progn 
      (while (setq line (read-line f$)) 
        (cond 
          ((or (= " " line) (= "" line))) 
          ((wcmatch (strcase line) "FENTAN-NUMBER*")(setq ll nil)) 
          (t (setq ll (cons line ll))) 
        ) 
      )(close f$) 
       
      (foreach line (reverse ll) 
        (setq fixGS 0) 
        (cond 
          ((not line)(setq line nil fixGS 3)) 
          ((= "" (vl-string-trim " " line))(setq line "==n" fixGS 3)) 
          ((= "==xj" line)(setq fixGS 1)) 
          ((= "==hj" line)(setq fixGS 2)) 
          ((= "==n" (substr line 1 3))(setq fixGS 3)) 
          ((= "==p" (substr line 1 3))(setq fixGS 4)) 
           
          ((wcmatch line "FENTAN-VER=*") 
            (setq a (ZWX::Split line (list "=") nil) 
                  l$ nil re$ nil old$ 3 
                  FCVer (if (cadr a) (atof (cadr a)) 0) 
            ) 
          ) 
          ((or (= "fentan-jzshuju" line) 
               (= "==tn" line) 
               (and (< FCVer 7) (= "房号" (substr line 1 4)))) 
             (setq dataLX 1 count 0 Save t LenRow 0 ixj 0 ihj 0) 
          ) 
          ((or (= "fentan-gyshuju" line) 
               (= "==gy" line) 
               (and (< FCVer 7) (= "项目" (substr line 1 4)))) 
             (setq dataLX 2 count 0 Save t LenRow 0 ixj 0 ihj 0) 
          ) 
          ((or (= "fentan-bzsm" line) (= "==sm" line)) 
             (setq dataLX 3 count 0 Save t) 
          ) 
        ) 
        
        (if (and Save l$) 
          (setq re$ (ZWX::bgSave1 l$) l$ nil) 
        ) 
 
        (cond 
          ((not line)) 
          ((= "" line)) 
          ((member line '("==tn" "==gy" "==sm"))) 
          ((= "fentan-" (strcase (substr line 1 7) t))) 
          ((= 3 dataLX) 
            (cond 
              ((= 1 fixGS)) 
              ((= 2 fixGS)) 
              (t (setq l$ (cons line l$))) 
            ) 
          ) 
          (t 
            (cond 
              ((< 0 fixGS)(setq l$ (cons line l$))) 
              (t 
                (setq a (ZWX::Split line (list (chr 9)) nil) 
                      
                      l$ (cons a l$) 
                      a (length a) 
                      LenRow (if (< LenRow a) a LenRow) 
                ) 
              ) 
            ) 
          ) 
        ) 
 
        (setq oldLX dataLX count (1+ count)) 
        (if (and (< dataLX 3) (< FCVer 7) (= "合计" (substr line 1 4))) 
             (setq Save t dataLX 3) 
             (setq Save nil) 
        ) 
      ) ;foreach 
 
      (if l$ (setq re$ (ZWX::bgSave1 l$) l$ nil)) 
      (setq re$ (reverse re$)) 
    ) ) 
;;;   (princ re$) 
  ) 
 
 ;是否允许多行打印PermitWrap 
 ; 
 (defun ZWX::bgprint1 (_collen _text _Leftcoor _height angle1 _style _Justify _color _layer PermitWrap / 
                _position jianxu 
                entg Text1 Text2 i a b c 
                LL RL aWidth 
                newText        newWidth 
                bRowHeight 
                len1 
                SSText 
               ) 
   (setq Text1 (if (= "—" _text) "-" _text) 
         i (strlen Text1) 
         entg (list (cons 7 _style)  ;字体类型 
                    (cons 40 _height) ;高度 
              ) 
         aWidth 1 
         Text2 Text1 
         jianxu 1.2 
   ) 
   ;(textbox '((1 . "层次:") (7 . "HZTXT") (41 . 0.85) (40 . 3.5))) 
    
   (while (and PermitWrap (< 1 i)) 
     (setq a (substr Text1 1 i) 
           Text2 (substr Text1 (1+ i)) 
           b (textbox (append (list (cons 1 a)) entg)) 
           LL (caar b) 
           RL (caadr b) 
           aWidth (- RL LL) 
           aWidth (if (equal 0 aWidth 0) 1 (/ (- _collen jianxu jianxu) aWidth)) 
     ) 
     (if (< aWidth 0.6) 
       (setq i (if (> (ascii a) 128) (- i 2) (1- i))) 
       (progn 
         (if (< 1 aWidth)(setq aWidth 1)) 
         (setq newText (cons a newText) 
               newWidth (cons aWidth newWidth) 
               Text1 (substr Text1 (1+ i)) 
               i (strlen Text1) 
         ) 
       ) 
     ) 
   ) 
    
   (if (/= "" Text2) 
     (setq newText (cons Text2 newText) 
           newWidth (cons aWidth newWidth) 
     ) 
   ) 
   (setq newText (reverse newText) 
         newWidth (reverse newWidth) 
         bRowHeight 0 
         SSText (ssadd) 
         i 0 
   ) 
   ;jianxu 字与边界的间隙 
   ;text字的内容,col输入所在列数,collen当前列的列宽,Leftcoor当前列的最左坐标, 
    
   (cond 
     ((wcmatch _Justify "*l*")(setq _position _Leftcoor)) 
     ((wcmatch _Justify "*c*")(setq _position (polar _Leftcoor 0 (/ _collen 2.000)))) 
     ((wcmatch _Justify "*r*")(setq _position (polar _Leftcoor 0 _collen))) 
   ) 
    
   (if (= 2 (length _position))(setq _position (append _position '(0)))) 
                     
   (foreach a newText 
     (command "text" "s" _style "j" _Justify _position _height angle1 a 
              "chprop" (entlast) "" "c" _color "la" _layer "" 
     ) 
     (setq b (entget (entlast)) 
           a (* 0.8 (if (= "-" a) 2 (nth i newWidth))) 
           b (subst (cons 41 a) (assoc 41 b) b) 
           _position (polar _position (* 1.5 pi) (+ 0.2 _height)) 
           bRowHeight (+ bRowHeight (if (> i 0) 0.2 0) _height) 
           SSText (ssadd (entlast) SSText) 
           i (1+ i) 
     ) 
     (entmod b) 
   ) 
 
  ;返回下一个输出点及当前本行的高度 
   (list (polar _Leftcoor 0 _collen) bRowHeight SSText i) 
 ) 
 
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  (defun ZWX::bgNextPage (thepagepoint / _nextpagepoint) 
    (if (= PAGEisROWorCOL "0")                                ;各页为横向排列或竖向排列 
      (setq _nextpagepoint (polar thepagepoint 0 (+ PAGEoffset PAGEwidth)))             ;横向 
      (setq _nextpagepoint (polar thepagepoint (* 1.5 pi) (+ PAGEoffset PAGEheight)))   ;竖向 
    ) 
    _nextpagepoint 
  ) 
 
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  ;;;封面 
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  (defun ZWX::bgpriCOVER (cover_p / _a _b _c _p) 
    (setq PAGEwidth 210.0 PAGEheight 297.0 printPAGEheight 267.69 
          _a (list BGBH FWZL TFBH FWMC WTDW "三明市测量队" CLRQ) 
          _p (list (+ (car cover_p) 76.32518) (- (cadr cover_p) 143.29072)) 
    ) 
    (command "insert" "FCBG_COVER1" cover_p "" "" ""); "explode" (entlast)) ;封面1 
    (foreach _b _a (progn 
     (if (= "" _b)(setq _b "?????")) 
     (setq _c (ZWX::bgprint1 80 _b _p 3.5 0 "DATA" "mc" "white" "数据" nil) 
           _p (polar _p (* 1.5 pi) 8) 
     ) 
    )) 
    (setq cover_p (ZWX::bgNextPage cover_p)) 
    (command "insert" "FCBG_COVER2" cover_p "" "" ""); "explode" (entlast)) ;;封面2 
    (setq cover_p (ZWX::bgNextPage cover_p)) 
    cover_p 
  ) 
 
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  ;;;目录 
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  (defun ZWX::bgpriLIST (LIST_p / _a _b _c _d _e _p) 
    ;ZYS XSGC JSJG DXTYS GCPMTYS 
    (if (or (not ZYS) (= "" ZYS))(setq ZYS "???")) 
    (if (or (not XSGC) (= "" XSGC))(setq XSGC "无")) 
    (if (or (not JSJG) (= "" JSJG))(setq JSJG "无")) 
    (if (or (not DXTYS) (= "" DXTYS))(setq DXTYS "???")) 
    (if (or (not GCPMTYS) (= "" GCPMTYS))(setq GCPMTYS "???")) 
    (setq PAGEwidth 210.0 PAGEheight 297.0 printPAGEheight 267.69) 
    (command "insert" "FCBG_LIST1" LIST_p "" "" ""); "explode" (entlast)) 
 
    (setq _c (ZWX::bgprint1 5.7 ZYS  (list (+ (car LIST_p) 101.5567) (- (cadr LIST_p) 65.34037)) 3 0 "DATA" "c" "white" "数据" nil) 
          _c (ZWX::bgprint1 5.7 XSGC (list (+ (car LIST_p) 165.5954) (- (cadr LIST_p) 107.2063)) 3 0 "DATA" "c" "white" "数据" nil) 
          _c (ZWX::bgprint1 5.7 JSJG (list (+ (car LIST_p) 165.5954) (- (cadr LIST_p) 115.2063)) 3 0 "DATA" "c" "white" "数据" nil) 
          _c (ZWX::bgprint1 5.7 DXTYS (list (+ (car LIST_p) 165.5954) (- (cadr LIST_p) 123.2063)) 3 0 "DATA" "c" "white" "数据" nil) 
          _c (ZWX::bgprint1 5.7 GCPMTYS (list (+ (car LIST_p) 165.5954) (- (cadr LIST_p) 131.2063)) 3 0 "DATA" "c" "white" "数据" nil) 
    ) 
    (ZWX::bgNextPage LIST_p) 
  ) 
 
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  ;;;页面左上角定位点_p,输出数据表print_l,为产权或共有CQMJorGYMJ,页面A3或A4规格pagesize 
  ;;;面积表格插入点对页定位点Y偏量old_Offset_Table 开始页数priPage 
  ;;;是否插入新页NewPage 表格跨页时输出次页起面积表格是否含表头haveHEADAfterFirstPage 
  ;;;首页是否插入固定页头insertFixHead 
  ;;; 
  (defun ZWX::bgpriMJB (_p print_l CQMJorGYMJ pagesize old_Offset_Table priPage NewPage haveHEADAfterFirstPage insertFixHead / 
                    a b c e f g i j aa bb b1 c1 i1 d1 startft page2 
                 Offset_Table 
                 CurRowNum ;当前页累计行数 
                 CountRow  ;总累计行数 
                 PrintRow  ;当前打印行数 
                 Head collen_l ;列宽表 
                 insertEmptyPAGE FCBGFixHead;插入空页 面积计算表头 
                 headheight ;当前行离建筑面积表格左上角的高度 
                 RowestLine LeftestLine;表头最下一条横线RowestLine,表最左边直线LeftestLine 
                 allColHeight ;本行的所有各列的高度 
                 AllExEnts    ;本行的所有竖线 
                 firstRowestLineP1 firstRowestLineP2;首行下横线 
                 firstRowestLineP3 firstRowestLineP4 
                 rowheight ;当前行度 
                 TableWidth  ;表格宽度 
                 sheight   ;当前行累计高度 
                 p_table p_line 
                 blank    
                 collenleft collenright ;列宽头和尾 
                 drawline_l 
 
                    computepoint       ;表示是否计算过到达该页可打印的最底下的边界; 
                   ) 
 
    (setq Offset_Table old_Offset_Table 
          head (car print_l) 
          page2 priPage 
          headheight 0 
    ) 
    
    (if print_l (progn 
    (if _p (progn 
      (ZWX::bgGetPage (length head)) 
      ;;; 
      ;;;构建各列的列宽表collen_l 
      ;正常打印宽度为180,最大打印宽度为195 
      ;当按正常打印宽度180计算各数据列宽度小于10.2时,则按最大打印宽度195重新计算数据列度 
      ;当数据列宽度大于17.7时,则将所有列的宽度按等份算 
      ; 
      (setq 
            b 0 c 0 e nil 
             
      ) 
 
      ;预先设置固定字段宽度 
      (if (= "CQMJ" CQMJorGYMJ) 
      (foreach a head 
        (setq d nil) 
        (cond ((= "房号" a) (setq d 13.7)) 
              ((= "层次" a) (setq d 10.2)) 
              ((= "开间" a) (setq d 15.1)) 
              ((= "套内" a) (setq d 15.1)) 
              ((= "建筑面积" a) (setq d 17.7)) 
        ) 
        (if d (setq b (1+ b)              ;固定字段个数 
                    c (+ c d)             ;固定字段总宽度 
                    e (cons (cons a d) e) ;保存固定字段的宽度 
              ) 
        ) 
      ) 
      ) 
           
      ;计算其余数据列宽度 
      (setq d (/ (- TableWidth c) (- (length head) b))) ;数据列的度 
           
      ;若其余数据列宽度过大或过小则调整其宽度 
      (cond 
        ((< d 10.2)   ;过小 
          (setq TableWidth (+ TableWidth 15.0)          ;修改表格宽度 
                d (/ (- TableWidth c) (- (length head) b)) ;修改数据列的宽度 
                OffsetPrintX 7.5        ;修改表格的横向偏移量 
          ) 
        ) 
        ((>= d 17.7)     ;过大 
          (setq d (/ TableWidth (length head)))    ;修改所有列的宽度 
          (if (>= d 40) (setq d 35 TableWidth (* (length head) d))) 
          (foreach a e 
            (setq e (subst (cons (car a) d) a e)) 
          ) 
        ) 
      ) 
 
      ;最后的列宽表collen_l 
      (foreach a head 
        (setq b (if (setq c (assoc a e)) (cdr c) d) 
              collen_l (cons b collen_l) 
        ) 
        (if (= "CQMJ" CQMJorGYMJ) 
        (cond 
          ((= "开间" a) (setq head (subst "套内使用及套内墙体建面和" a head))) 
          ((= "阳台" a) (setq head (subst "阳台建面" a head))) 
          ((= "半封阳台" a) (setq head (subst "半封阳台建面" a head))) 
          ((= "未封阳台" a) (setq head (subst "未封阳台建面" a head))) 
          ((= "非封阳台" a) (setq head (subst "非封阳台建面" a head))) 
          ((= "全封阳台" a) (setq head (subst "全封阳台建面" a head))) 
          ((= "封闭阳台" a) (setq head (subst "封闭阳台建面" a head))) 
          ((= "套内" a) (setq head (subst "套内建筑面积" a head))) 
        ) 
        ) 
      ) 
 
      ;;;参数初始化 
      (setq collen_l (reverse collen_l) 
            print_l (subst head (car print_l) print_l) 
            CountRow 0 CurRowNum 0 sheight 0 
      ) 
 
      (while (< CountRow (length print_l)) (progn 
 
        (if (= 0 CurRowNum) (progn 
         (if NewPage (progn 
 
           ;放样新空白页和表格 
           (command "zoom" "w" _p (list (+ (car _p) PAGEwidth) (- (cadr _p) PAGEheight) 0)) 
           
           ;(InsertPoint insertOffSet insertFixHead aPageSize 
           (ZWX::bgOrientPage _p Offset_Table (= startpage page2) PageSize) 
           
         ));(if NewPage 
 
         (if (or (not old_Offset_Table) (> 20 old_Offset_Table)) 
           (if (and insertFixHead (= startpage page2)) 
             ;当首页且需要插入固定页头时Offset_Table=34.5 
              (setq Offset_Table 34.5) ;首页 
              (setq Offset_Table 20)   ;其他页 
           ) 
         ) 
         (setq p_table (list (+ (car _p) OffsetPrintX) (- (cadr _p) Offset_Table) 0))         ;插入表格位置 
          
         ;绘表格最顶及最左边的一条线 
         (setq RowestLine (ZWX::bgDrawLine p_table (strcat "@" (rtos TableWidth) "<0")) 
               f p_table 
         ) 
         ;用offset绘出所有的竖线并将所有的竖线保存于AllExEnts 
         (foreach a (append '(0) collen_l) 
           (setq f (polar f 0 a)               ;竖线上端点 
                 c (polar f (* 1.5 pi) 1)      ;竖线下端点 
                 LeftestLine (ZWX::bgDrawLine f c)   ;开始画线 
                 AllExEnts (cons (list LeftestLine c) AllExEnts)  ;保存所有竖线 
           ) 
         ) 
 
        ));(if (= 0 CurRowNum) (progn 
 
        ;每页表格是否输出该表格的第一行数据 
        (if (and (= 0 CurRowNum) (< priPage page2) haveHEADAfterFirstPage) 
          (setq i 0 CountRow (1- CountRow)) ;FixText 
          (setq i CountRow) 
        ) 
        (setq rowheight limitrowheight 
              aa (nth i print_l) 
              ;;;写行据(ZWX::bgPriGridRowData LeftTopPoint Offset RowData aColsWidth) 
              allColHeight (ZWX::bgPriGridRowData p_table (+ sheight (/ rowheight 2)) aa collen_l i) 
        
              rowheight (+ (* swheight HANGJU) allColHeight) 
              sheight (+ sheight rowheight) 
              
              f (polar p_table (* 1.5 pi) sheight) 
              ;;;绘当前行的下线 
              RowestLine (ZWX::bgDrawLine f (strcat "@" (rtos TableWidth) "<0")) 
              CurRowNum (1+ CurRowNum) 
              computepoint nil 
        ) 
        
 
        ;;;若下一行超出打印范围则须插入新的一页 
        (if (< printPAGEheight (+ Offset_Table sheight limitrowheight headheight)) 
          (setq CurRowNum 0 
                _p (ZWX::bgNextPage _p) 
                NewPage t old_Offset_Table nil page2 (1+ page2) 
                Offset_Table nil 
                computepoint t 
          ) 
        ) 
        (if (or (= 0 CurRowNum) (= (1+ CountRow) (length print_l)))(progn  ;(equal aa (last print_l)) 
          ;;;将当前表格的所有竖线拉伸至表格尾部 
          ;;;创建选择集 
          (command "_extend" RowestLine "") 
          (foreach b1 AllExEnts (command b1)) 
          (command "") 
          (if (and (not computepoint) (equal aa (last print_l))) 
            (setq p_table (polar p_table (* 1.5 pi) (+ headheight sheight 0.1)) 
                  Offset_Table (- (cadr _p) (cadr p_table)) 
            ) 
          ) 
          (setq sheight 0 AllExEnts nil) 
        )) 
 
        (setq CountRow (1+ CountRow) RowestLine nil) 
      )) 
           
;;;    (princ (> pageheight (+ Offset_Table swheight))) 
    ;;;返回当前报告页左上角点及产权面积表最下一横线标 
    (if (not computepoint) 
    (if (> pageheight (+ Offset_Table swheight)) 
      (setq NewPage nil Offset_Table (+ Offset_Table swheight)) 
      (setq NewPage t Offset_Table 25 page2 (1+ page2)) 
    ) 
    ) 
 
     )) 
    )(princ "\n没有可填写的记录,记录为空!")) 
    (list _p Offset_Table pagesize page2 NewPage) 
  ) 
   
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  ;;;;;;;打印一般文字;;;;;;;;;;;;;;;;;;;;;;; 
 
  (defun ZWX::bgpriRemark (_p print_l pagesize old_Offset_Table priPage NewPage / 
                    a b c e f g i j aa bb startft page2 
                 Offset_Table 
                 head 
                 startft ;属分摊数据的开始位置 
                 collen_l ;列宽表 
                 ;插入第三页的名称insertPAGEn3 插入建筑面积表格的名称inserttable 
                 insertPAGEn3 insertPAGEn4 inserttable 
                 headheight ;当前行离建筑面积表格左上角的高度 
                 RowestLine ;表头最下一条横线 
                 firstRowestLineP1 firstRowestLineP2;首行下横线 
                 rowheight ;当前行高度 
                 sheight   ;当前行累计高度 
                 p_table p_line 
 
                   ) 
 
    (setq Offset_Table old_Offset_Table page2 priPage) 
    (if print_l (progn 
    (if _p (progn 
      (ZWX::bgGetPage (length head)) 
      ;;;参数初始化 
      (setq g 0 sheight 0 rowheight (* 1.2 swheight)) 
 
      (foreach aa print_l (progn 
 
        (if (= 0 g) (progn ;放样表格 
         (if NewPage (progn 
           (command "zoom" "w" _p (list (+ (car _p) PAGEwidth) (- (cadr _p) PAGEheight) 0)) 
           (ZWX::bgOrientPage _p Offset_Table (= startpage page2) PageSize) 
         )) 
          
         (if (not old_Offset_Table) 
           (if (= 3 page2) 
              (setq Offset_Table 34.5) ;首页 
              (setq Offset_Table 20)   ;其他页 
           ) 
         ) 
         (setq p_table (polar _p (* 1.5 pi) Offset_Table)) 
        ));(if (= 0 g) (progn 
 
        ;;;写行数据 
        (setq f (polar _p (* 1.5 pi) (+ Offset_Table sheight swheight))  ;(/ rowheight 2) 
              f (ZWX::bgprint1 (- pagewidth 30) aa (polar f 0 OffsetPrintX) swheight 0 
                        "remark" 
                        ;(if (wcmatch aa "*÷*") "remark" "FixText") 
                        "bl" "white" "数据" t 
                ) 
        ) 
        (setq g (1+ g) sheight (+ sheight rowheight)) 
 
        ;;;若下一行超出打印范围则须插入下一页 
        (if (< printPAGEheight (+ Offset_Table sheight)) 
          (setq g 0 _p (ZWX::bgNextPage _p) NewPage t old_Offset_Table nil page2 (1+ page2)) 
        ) 
        (if (or (= 0 g) (eq aa (last print_l)))(progn 
          (if (eq aa (last print_l)) 
            (setq p_table (polar p_table (* 1.5 pi) sheight) 
                  Offset_Table (- (cadr _p) (cadr p_table)) 
            ) 
          ) 
          (setq sheight 0) 
        )) 
      )) 
    ;;;返回当前报告页左上角点及产权面积表最下一横线的坐标 
    (if (> printPAGEheight (+ Offset_Table swheight)) 
      (setq NewPage nil Offset_Table (+ Offset_Table swheight)) 
      (setq NewPage t Offset_Table 25 page2 (1+ page2)) 
    ) 
     )) 
    )) 
 
    (list _p Offset_Table pagesize page2 NewPage) 
  ) 
 
  ; 
  ; 
  ; 
  (defun ZWX::bgReset (inflname / a b dwg_flpath) ;设置参数 
   (if inflname 
     (setq cgb_filename (ZWX::FilebyExName inflname "cgb")) 
     (setq cgb_filename (Get-thisFileName "cgb")) 
   ) 
    (ZWX::bgGetSet) 
    (setq data_list (ZWX::bgReadCGB cgb_filename) 
          HANGJU (atof HANGJU) 
          PAGEoffset (atof PAGEoffset) 
          zjheight (* swheight 0.8) 
          limitrowheight (+ swheight (* swheight HANGJU)) 
          ver1 "7.0" 
    ) 
  ) 
 
;参数包括;指定打印页printnum,打印文件inPrintFile,文件类型FileType(特指cgb或dwg文件) 
(defun c:printfcbg (printnum inPrintFile FileType InfSetFile / 
                    p oldos oldl ver1 
                 data_list 
                     
                 bgbh jzmj fwzl fwmc wtdw tfbh zcc clrq dxhtrq fcbl dxbl 
                 HANGJU CQorYSorJZ_MJ 
                 ZTDX CHHTY 
                 ZYS XSGC JSJG DXTYS GCPMTYS        ;总页数ZYS  计算过程XSGC JSJG 
 
                    fixPAGESIZE fixPAGEFX 
                    ZTBLLimit LimitValue 
                  
                 cgb_filename 
 
                 PAGEwidth  PAGEheight     ;页宽PAGEwidth 页高PAGEheight 
                 PAGEisROWorCOL PAGEoffset ;各页为横向排列或竖向排列PAGEisROWorCOL 页与页之间的距离PAGEoffset 
                 printPAGEheight printPAGEWidth          ;可打印页高; 
                 ;输出数据或表格时X方向的偏移量; 
                 OffsetPrintX 
                     
                 printnum                  ;打印内容选择 
                 limitROWheight            ;限制行高limitrowheight须大于3.8mm 
                 swheight zjheight         ;首尾字高swheight 中间字高zjheight 
 
                 startpage                 ;本次输出的起始页数; 
                 curpage                   ;当前输出所在的页数; 
             ) 
   
  (c:ShowZWXFCRegInf) 
   
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
  ;;;主程序                     ; 
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
 
  (if (and printnum (setq p (getpoint "\n输入表格左上角位置(回车退出):")))(progn 
 
    (ZWX::bgReset inPrintFile) 
    
    (setvar "cmdecho" 0) 
    (command "undo" "control" "all" "undo" "be") 
    (setq oldos (getvar "osmode") oldl (getvar "clayer")) 
    (setvar "osmode" 0)(setvar "clayer" "0") 
 
    (setq a '(("layer" "数据" 7) ("layer" "表格" 5) 
              ("style" "FixText" "isocp.shx,chin2.shx") 
              ("style" "remark" "isocp.shx,fhztxt.shx") 
              ("style" "DATA" "simplex.shx,chin2.shx") 
             ) 
          OffsetPrintX 15 
    ) 
    (foreach b a 
      (if (not (tblsearch (car b) (cadr b))) 
        (cond 
          ((= "layer" (car b)) 
            (command "layer" "n" (cadr b) "c" (caddr b) (caddr b) "") 
          ) 
          ((= "style" (car b)) 
            (command "style" (cadr b) (caddr b) 0 1 0 "" "") 
          ) 
        ) 
      ) 
    ) 
 
    (if (member "1" printnum) 
     (setq p (ZWX::bgpriCOVER p)) 
    ) 
 
    (if (and data_list (member "3" printnum)) (progn 
     (setq p (list p nil nil 3 t) startpage 3) 
     (foreach a data_list (progn 
       (cond 
         ((= 1 (car a));CQMJ_l 
           (setq p (ZWX::bgpriMJB (car p) (cadr a) "CQMJ" (nth 2 p) (nth 1 p) (nth 3 p) (nth 4 p) t t)) 
         ) 
         ((= 2 (car a));GYMJ_l 
           (setq p (ZWX::bgpriMJB (car p) (cadr a) "GYMJ" (nth 2 p) (nth 1 p) (nth 3 p) (nth 4 p) t t)) 
         ) 
         ((= 3 (car a));BZSM_l 
           (setq p (ZWX::bgpriRemark (car p) (cadr a) (nth 2 p) (nth 1 p) (nth 3 p) (nth 4 p))) ;(nth 3 p) 
         ) 
       );(princ (nth 3 p)) 
     )) 
     (command "insert" "FC_LUOKUAN" (list (+ (caar p) OffsetPrintX) (- (cadar p) (cadr p))) "" "" "") 
     ; "explode" (entlast)) ;插入落款 
 
     (setq a (nth 3 p) 
           p (ZWX::bgNextPage (car p)) 
      
           a (cond ((= 3 a) "3") 
                   ((= 4 a) "3,4") 
                   ((< 4 a) (strcat "3-" (itoa a))) 
                   (t "???") 
             ) 
           XSGC a JSJG a 
     ) 
 
     (ZWX::PutFCInf (list (list "XSGC" XSGC) (list "JSJG" JSJG))) 
    )) 
 
    (if (member "2" printnum) 
     (setq p (ZWX::bgpriLIST p)) 
    ) 
 
    (setvar "osmode" oldos)(setvar "clayer" oldl) 
    (command "undo" "e")(setvar "cmdecho" 1) 
  )) 
  (gc) 
;;;  (princ) 
) 
 
 
(defun c:-a10 ( / a printnum) 
  (if (/= "" (setq printnum (getstring "\n [1.首页/2.目录/3.建筑面积表,共有面积表,步骤说明/4.完整报告]\n选择输出报告内容(可用逗号输入多项):"))) 
      (progn 
    (if (= "4" printnum)(setq printnum "1,2,3,4")) 
    (setq printnum (ZWX::Split (strcat printnum ",") '(",") nil)) 
    (c:printfcbg printnum nil "dwg" nil) 
  )) 
  (princ) 
) 
 
 
(defun c:a10 ( / dcl_id dwg-flname dwg-flpath datfile cgbfile printnum 
                 dwgfile 
                 selprintbg opendlg look_file 
             ) 
  (defun selprintbg (in$) 
      (if (= "1" (get_tile "wzbg")) 
        (progn 
          (mode_tile "bgfm" 1) 
          (mode_tile "bgml" 1) 
          (mode_tile "bgjzb" 1) 
          (setq printnum '("1" "2" "3")) 
        ) 
        (progn 
          (mode_tile "bgfm" 0) 
          (mode_tile "bgml" 0) 
          (mode_tile "bgjzb" 0) 
        ) 
      ) 
    (if (= 1 in$) 
       (if (= "1" (get_tile "wzbg")) 
          (setq printnum '("1" "2" "3")) 
       ) 
       (progn 
          (setq printnum nil) 
          (if (= "1" (get_tile "bgjzb")) 
             (setq printnum (cons "3" printnum)) 
          ) 
          (if (= "1" (get_tile "bgml")) 
             (setq printnum (cons "2" printnum)) 
          ) 
          (if (= "1" (get_tile "bgfm")) 
             (setq printnum (cons "1" printnum)) 
          ) 
       ) 
    ) 
  ) 
  (defun opendlg ($key / a a1 a2 a3) 
    (cond 
      ((= "opencgb" $key)(setq a1 "选择成果表文件(*.cgb)" a2 cgbfile a3 "cgb")) 
      ((= "opendat" $key)(setq a1 "选择房产信息文件(*.dat)" a2 datfile a3 "dat")) 
    ) 
    (if (setq a (getfiled a1 a2 a3 2)) 
      (progn 
      (cond 
      ((= "opencgb" $key)(setq cgbfile a) (set_tile "cgbfile" cgbfile)) 
      ((= "opendat" $key)(setq datfile a) (set_tile "datfile" datfile)) 
      ) 
      ) 
    ) 
  ) 
 
  (defun look_file (inFile /) 
    (if (findfile inFile) 
      (startapp "notepad.exe" inFile) 
      (alert (strcat "找不到该文件\n" inFile)) 
    ) 
  ) 
    
    (if (not (setq dcl_id (load_dialog "FCPriGrid.dcl")))(exit)) 
    (if (not (new_dialog "dlg_FCMJBG" dcl_id))(exit)) 
    (setq dwg-flname (getvar "dwgname") dwg-flpath (getvar "dwgprefix")) 
    (if (/= "\" (substr dwg-flpath (strlen dwg-flpath) 1))(setq dwg-flpath "\")) 
    (setq dwg-flname (strcat dwg-flpath dwg-flname) 
          datfile (strcat (substr dwg-flname 1 (- (strlen dwg-flname) 3)) "dat") 
          cgbfile (strcat (substr dwg-flname 1 (- (strlen dwg-flname) 3)) "cgb") 
    ) 
    (setq printnum '("1" "2" "3")) 
    (set_tile "wzbg" "1") 
    (selprintbg 1) 
    (set_tile "datfile" datfile) 
    (set_tile "cgbfile" cgbfile) 
   
    (action_tile "opendat"     "(opendlg $key)") 
    (action_tile "lookdatfile" "(look_file datfile)") 
    (action_tile "opencgb"     "(opendlg $key)") 
    (action_tile "lookcgbfile" "(look_file cgbfile)") 
    (action_tile "wzbg"        "(selprintbg 1)") 
    (action_tile "bgfm"        "(selprintbg 2)") 
    (action_tile "bgml"        "(selprintbg 3)") 
    (action_tile "bgjzb"       "(selprintbg 4)") 
    (action_tile "editcanshu"  "(Edit-InfSetFile nil)") 
    (action_tile "editmulu"    "(Edit-FCMJBG-SET nil)") 
    (action_tile "accept"      "(done_dialog 1)") 
    (action_tile "cencel"      "(done_dialog 0)") 
    (if (= 1 (start_dialog))(progn 
;;;      (setq dwgfile (strcat (substr cgbfile 1 (- (strlen cgbfile) 3)) "dwg")) 
      (c:printfcbg printnum cgbfile "cgb" datfile) 
    )) 
  (princ) 
) 
 
(defun c:edit_cgb( / a cgb_filename) 
     (setq a (getvar "dwgname") b (getvar "dwgprefix") 
           a (substr a 1 (- (strlen a) 4)) 
           cgb_filename (strcat b a ".cgb") 
     ) 
  (if (setq a (open cgb_filename "a")) (progn 
    (princ "\nFENTAN-NUMBER=1" a) 
    (princ "\nFENTAN-VER=7.0" a) 
    (princ "\n" a) 
    (close a) 
  )) 
  (startapp "notepad.exe" cgb_filename) 
  (princ) 
) 
  [/FONT]

killer9806 · 发表于 2007-1-16 14:02:14

偶运行了一下，有点问题，看来要自已动手才能丰衣足食

losvagos · 发表于 2007-2-2 14:47:04

真是不错啊~~~

yitian519 · 发表于 2007-3-25 11:29:43

怎么运行啊?好象不能运行

zhang8fu · 发表于 2007-9-8 10:24:27

有点问题啊
不会弄啊
救命啊

Jason1010 · 发表于 2007-9-9 22:06:06

好复杂，看不懂。但还是很佩服楼上的。

linxu100 · 发表于 2008-6-27 06:32:07

应该很好

lwjzbj · 发表于 2008-7-2 10:06:36

能不能直接做成一个文件，这样我们直接下载就好了

wangxj2002 · 发表于 2008-7-2 10:18:01

支持一下哈！！

030008 · 发表于 2008-7-18 16:14:53

确实有点问题，需要改进！

baihua168 · 发表于 2008-11-14 19:12:34

好长啊，看半天不懂

ccshappy · 发表于 2008-12-8 18:51:03

好长
搞什么用的

bean2008 · 发表于 2008-12-13 13:21:58

怎么用怎么加载？？？

c_wm · 发表于 2008-12-29 23:18:11

能来个演示就好

xiaofengwang · 发表于 2008-12-31 15:58:26

感觉好难，我都不敢尝试写这种！

账号		自动登录	找回密码
密码			立即注册

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

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

相关帖子