需要找出是什么原因造成的，因为没有桌子部分它不会崩溃。 我解决了问题，但没有找到答案。
在创建表格之前，将创建一个Table_样式。
此代码（试用和错误构建）导致错误。
它还应该检查table_样式是否已经存在，但在某个地方崩溃了
第二次调用子函数。
(defun CTS (/ acmcol adoc clsname keyname newstyleobj tbldict tblstylename)
;(vl-load-com)
(or adoc
(setq adoc
(vla-get-activedocument
(vlax-get-acad-object)
)
)
)
(setq tbldict
(vla-item
(vla-get-dictionaries
(vla-get-database adoc)
)
"Acad_TableStyle"
)
)
;; look in the tablestyle dictionary to search for our style name:
(if
(vl-catch-all-error-p
(setq tbstyleObj
(vl-catch-all-apply
(function (lambda() (vla-item tbldict "Anchor Table")))
)
)
)
;; if table style "TblStyleName" does not exist:
(progn
(setq keyname "NewStyle"
clsname "AcDbTableStyle"
tblstylename "Anchor Table"
)
(setq newstyleobj
(vlax-invoke tbldict 'Addobject keyname clsname)
)
(setq acmcol (vla-GetInterfaceObject
(vlax-get-acad-object)
(strcat "AutoCAD.AcCmColor." (itoa (atoi(getvar "acadver"))))
)
)
(vlax-put acmcol 'Colorindex 254)
(vlax-put newstyleobj 'Name TblStyleName)
(vlax-put newstyleobj 'Description "Anchor Table")
(vlax-put newstyleobj 'HorzCellMargin 0.25)
(vlax-put newstyleobj 'VertCellMargin 0.25)
(vlax-put newstyleobj 'TitleSuppressed :vlax-false)
(vlax-put newstyleobj 'HeaderSuppressed :vlax-false)
(vlax-invoke newstyleobj 'SetBackgroundColor acTitleRow acmcol)
(vlax-invoke newstyleobj 'SetBackgroundColorNone acDataRow :vlax-false)
(vlax-invoke newstyleobj 'SetGridLineWeight acHorzBottom acTitleRow acLnWt035)
(vlax-invoke newstyleobj 'SetTextStyle (+ acHeaderRow acTitleRow) "Arial-B")
(vlax-invoke newstyleobj 'SetTextStyle acDataRow "Arial")
(vlax-invoke newstyleobj 'SetTextHeight acTitleRow 2.5)
(vlax-invoke newstyleobj 'SetTextHeight (+ acDataRow acHeaderRow) 1.5)
(vlax-invoke newstyleobj 'SetGridVisibility acHorzInside(+ acDataRow acHeaderRow) :vlax-true)
(vlax-invoke newstyleobj 'SetAlignment (+ acDataRow acTitleRow) acMiddleCenter)
(vlax-invoke newstyleobj 'SetAlignment acHeaderRow acMiddleCenter)
)
;;inform user if style exist:
(princ (strcat "\nStyle \"" tblstylename "\" already exist."))
)
(setvar "ctablestyle" "Anchor Table")
(princ)
)
在创建表之前调用该函数：
(defun c:test ( / lay lst obj )
(vl-load-com)
(CTS)
(setq lst (mapcar 'strcase (layoutlist)))
(while
(and (/= "" (setq lay (getstring t "\nEnter layout for table: ")))
(or
(and
(not (member (strcase lay) lst))
(princ (strcat "\nLayout \"" lay "\" doesn't exist."))
)
(and
(setq sel (ssget "_X" (list '(0 . "ACAD_TABLE") '(8 . "29-anchor wires-#*") (cons 410 lay))))
(princ
(strcat
"\nA table already exists on layer \""
(cdr (assoc 8 (entget (ssname sel 0))))
"\" in layout \"" lay "\"."
)
)
)
)
)
)
(if (/= "" lay)
(progn
(setq objtable
(vla-addtable
(vla-get-block (vla-item (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))) lay))
(vlax-3D-point 312 289)
11 10 4.652 9.356
)
)
(foreach col '(6 7 8 9)
(vla-setcelltextheight objtable 1 col 1.25)
)
(vla-settext objtable 0 0 "STINGRAY ANCHORS")
(vla-settext objtable 1 1 "EASTING")
(vla-settext objtable 1 3 "NORTHING")
(vla-settext objtable 1 5 "ANGLE")
(vla-settext objtable 1 6 "LENGTH ANCHORE WIRE")
(vla-settext objtable 1 7 "MIDLINE BUOY 1 *")
(vla-settext objtable 1 8 "MIDLINE BUOY 2 *")
(vla-settext objtable 1 9 "MIDLINE BUOY 3 *")
(vla-MergeCells objtable 1 1 1 2)
(vla-MergeCells objtable 1 1 3 4)
(vla-put-HorzCellMargin objtable 0.25)
(vla-put-VertCellMargin objtable 0.25)
(vla-setrowheight objtable 1 10)
(vla-setcolumnwidth objtable 0 15.182); 0 is first column
(vla-setcolumnwidth objtable 1 4.756)
(vla-setcolumnwidth objtable 2 13.956)
(vla-setcolumnwidth objtable 3 4.756)
(vla-setcolumnwidth objtable 4 13.956)
(vla-setcolumnwidth objtable 5 9.969)
(foreach col '(6 7 8 9)
(vla-setcolumnwidth objtable col 9.356)
)
)
)
(princ)
)
页:
1
[2]