桌子
好的，我已经看过了，我似乎还没有准备好我需要的桌子。我需要一个lisp来创建一个表。我刷了多行，我需要表采取所有这些属性，并创建一个表。也有它正在做，我需要它来结合像线，并把他们加在一个数量列。
我看过很多桌子，但我不知道如何改变来做我需要的。我仍在阅读和学习，但仍然不知道足够做这件事。 这不是您想要的，但显示了如何制作一个表并用可变数量的信息填充它。您只需对文本进行ssget，而不是读取块属性。
; DWG INDEX TO A TABLE
; BY ALAN H NOV 2013
(DEFUN AH:DWGINDEX (/ DOC OBJTABLE SS1 LAY ANS ANS2 PLOTABS SS1 TAG2 TAG3 LIST1 LIST2 CURLAYOUT COLWIDTH NUMCOLUMNS NUMROWS INC ROWHEIGHT )
(VL-LOAD-COM)
(SETQ CURLAYOUT (GETVAR "CTAB"))
(IF (= CURLAYOUT "MODEL")
(PROGN
(ALERT "YOU NEED TO BE IN A LAYOUT FOR THIS OPTION")
(EXIT)
) ; END PROGN
) ; END IF MODEL
(SETQ DOC (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)))
(SETQ CURSPACE (VLA-GET-PAPERSPACE DOC))
(SETQ PT1 (VLAX-3D-POINT (GETPOINT "\NPICK POINT FOR TOP LEFT HAND OF TABLE:")))
; READ VALUES FROM TITLE BLOCKS
(SETQ BNAME "DA1DRTXT")
(SETQ TAG2 "DRG_NO") ;ATTRIBUTE TAG NAME
(SETQ TAG3 "WORKS_DESCRIPTION") ;ATTRIBUTE TAG NAME
(SETQ SS1 (SSGET "X"(LIST (CONS 0 "INSERT") (CONS 2 BNAME))))
(IF (= SS1 NIL) ; FOR TOMKINSON JOBS
(PROGN
(SETQ BNAME "xxx_TITLE")
(SETQ SS1 (SSGET "X"(LIST (CONS 0 "INSERT") (CONS 2 BNAME))))
)
)
(SETQ INC (SSLENGTH SS1))
(REPEAT INC
(FOREACH ATT (VLAX-INVOKE (VLAX-ENAME->VLA-OBJECT (SSNAME SS1 (SETQ INC (- INC 1)) )) 'GETATTRIBUTES)
(IF (= TAG2 (STRCASE (VLA-GET-TAGSTRING ATT)))
(PROGN
(SETQ ANS (VLA-GET-TEXTSTRING ATT))
(IF (/= ANS NIL)
(SETQ LIST1 (CONS ANS LIST1))
) ; IF
); END PROGN
) ; END IF
(IF (= TAG3 (STRCASE (VLA-GET-TAGSTRING ATT)))
(PROGN
(SETQ ANS2 (VLA-GET-TEXTSTRING ATT))
(IF (/= ANS2 NIL)
(SETQ LIST2 (CONS ANS2 LIST2))
) ; END IF
) ; END PROGN
) ; END IF TAG3
) ; END FOREACH
) ; END REPEAT
(SETVAR 'CTAB CURLAYOUT)
(COMMAND-S "ZOOM" "E")
(COMMAND-S "REGEN")
(REVERSE LIST1)
;(REVERSE LIST2)
; NOW DO TABLE
(SETQ NUMROWS (+ 2 (SSLENGTH SS1)))
(SETQ NUMCOLUMNS 2)
(SETQ ROWHEIGHT 0.2)
(SETQ COLWIDTH 150)
(SETQ OBJTABLE (VLA-ADDTABLE CURSPACE PT1 NUMROWS NUMCOLUMNS ROWHEIGHT COLWIDTH))
(VLA-SETTEXT OBJTABLE 0 0 "DRAWING REGISTER")
(VLA-SETTEXT OBJTABLE 1 0 "DRAWING NUMBER")
(VLA-SETTEXT OBJTABLE 1 1 "DRAWING TITLE")
(SETQ X 0)
(SETQ Y 2)
(REPEAT (SSLENGTH SS1)
(VLA-SETTEXT OBJTABLE Y 0 (NTH X LIST1))
(VLA-SETTEXT OBJTABLE Y 1 (NTH X LIST2))
(VLA-SETROWHEIGHT OBJTABLE Y 7)
(SETQ X (+ X 1))
(SETQ Y (+ Y 1))
)
(VLA-SETCOLUMNWIDTH OBJTABLE 0 55)
(VLA-SETCOLUMNWIDTH OBJTABLE 1 170)
(COMMAND-S "_ZOOM" "E")
); END AH DEFUN
(AH:DWGINDEX)
(PRINC)
比加尔，
这是我发现的口吃之一。由于我对lisps了解不够，我不知道如何根据需要更改它。不过谢谢你。如果有人能告诉我我在看什么，也许我可以改变它。 你能举个实际的例子吗？ 这样地。。
嗯，我无法上传jpeg，所以我会尝试解释。
3列
层名称长度数量
示例1 5’3
示例1 2’5
示例2 5’10
我有一个lisp，我可以得到这个信息，但不知道如何插入到一个表中。 李·麦克的这首歌很管用。如果有人能告诉我什么是表格信息，什么是选择文本。我试着把我的部分文字插入到这个地方，但没有成功。
;;--------------------=={ Text Count }==----------------------;;
;; ;;
;;Counts the number of occurrences of each string in a ;;
;;selection and produces a report in an ACAD Table object ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Version 1.0-07.11.2010 ;;
;;First Release. ;;
;;------------------------------------------------------------;;
;;Version 1.1-05.08.2011 ;;
;;Added Dimensions Override Text & MLeaders ;;
;;Updated 'AddTable' to account for Annotative Text Styles. ;;
;;------------------------------------------------------------;;
(defun c:tCount
( /)
*error*
_StartUndo
_EndUndo
_Assoc++
_SumAttributes
_GetTextString
_ApplyFooToSelSet
acdoc
acspc
alist
data
pt
)
;;------------------------------------------------------------;;
(defun *error* ( msg )
(if acdoc (_EndUndo acdoc))
(if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
(princ (strcat "\n** Error: " msg " **"))
)
(princ)
)
;;------------------------------------------------------------;;
(defun _StartUndo ( doc ) (_EndUndo doc)
(vla-StartUndoMark doc)
)
;;------------------------------------------------------------;;
(defun _EndUndo ( doc )
(if (= 8 (logand 8 (getvar 'UNDOCTL)))
(vla-EndUndoMark doc)
)
)
;;------------------------------------------------------------;;
(defun _Assoc++ ( key alist )
(
(lambda ( pair )
(if pair
(subst (list key (1+ (cadr pair))) pair alist)
(cons(list key 1) alist)
)
)
(assoc key alist)
)
)
;;------------------------------------------------------------;;
(defun _SumAttributes ( entity alist )
(while
(not
(eq "SEQEND"
(cdr
(assoc 0
(entget
(setq entity (entnext entity))
)
)
)
)
)
(setq alist (_Assoc++ (_GetTextString entity) alist))
)
)
;;------------------------------------------------------------;;
(defun _GetTextString ( entity )
(
(lambda ( string )
(mapcar
(function
(lambda ( pair )
(if (member (car pair) '(1 3))
(setq string (strcat string (cdr pair)))
)
)
)
(entget entity)
)
string
)
""
)
)
;;------------------------------------------------------------;;
(defun _ApplyFooToSelSet ( foo ss / i )
(if ss (repeat (setq i (sslength ss)) (foo (ssname ss (setq i (1- i))))))
)
;;------------------------------------------------------------;;
(setq acdoc (vla-get-activedocument (vlax-get-acad-object))
acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'Paperspace 'Modelspace))
)
(cond
( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar 'CLAYER))))))
(princ "\nCurrent Layer Locked.")
)
( (not (vlax-method-applicable-p acspc 'AddTable))
(princ "\nTable Object not Available in this version.")
)
( (and
(setq data
(_ApplyFooToSelSet
(lambda ( entity / typ )
(setq alist
(cond
( (eq "INSERT" (setq typ (cdr (assoc 0 (entget entity)))))
(_SumAttributes entity alist)
)
( (eq "MULTILEADER" typ)
(_Assoc++ (cdr (assoc 304 (entget entity))) alist)
)
( (wcmatch typ "*DIMENSION")
(_Assoc++ (cdr (assoc 1 (entget entity))) alist)
)
( (_Assoc++ (_GetTextString entity) alist) )
)
)
)
(ssget
'(
(-4 . "<OR")
(0 . "TEXT,MTEXT,MULTILEADER")
(-4 . "<AND")
(0 . "INSERT")
(66 . 1)
(-4 . "AND>")
(-4 . "<AND")
(0 . "*DIMENSION")
(1 . "*?*")
(-4 . "AND>")
(-4 . "OR>")
)
)
)
)
(setq pt (getpoint "\nSpecify Point for Table: "))
)
(_StartUndo acdoc)
(LM:AddTable acspc (trans pt 1 0) "String Count"
(cons (list "String" "Instances")
(vl-sort
(mapcar
(function
(lambda ( x ) (list (car x) (itoa (cadr x))))
)
data
)
(function (lambda ( a b ) (< (car a) (car b))))
)
)
)
(_EndUndo acdoc)
)
)
(princ)
)
;;---------------------=={ Add Table }==----------------------;;
;; ;;
;;Creates a VLA Table Object at the specified point, ;;
;;populated with title and data ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;space - VLA Block Object ;;
;;pt - Insertion Point for Table ;;
;;title - Table title ;;
;;data- List of data to populate the table ;;
;;------------------------------------------------------------;;
;;Returns:VLA Table Object ;;
;;------------------------------------------------------------;;
(defun LM:AddTable (space pt title data / _isAnnotative textheight style )
(defun _isAnnotative ( style / object annotx )
(and
(setq object (tblobjname "STYLE" style))
(setq annotx (cadr (assoc -3 (entget object '("AcadAnnotative")))))
(= 1 (cdr (assoc 1070 (reverse annotx))))
)
)
(
(lambda ( table ) (vla-put-StyleName table (getvar 'CTABLESTYLE)) (vla-SetText table 0 0 title)
(
(lambda ( row )
(mapcar
(function
(lambda ( rowitem ) (setq row (1+ row))
(
(lambda ( column )
(mapcar
(function
(lambda ( item )
(vla-SetText table row (setq column (1+ column)) item)
)
)
rowitem
)
)
-1
)
)
)
data
)
)
0
)
table
)
(
(lambda ( textheight )
(vla-AddTable space (vlax-3D-point pt) (1+ (length data)) (length (car data)) textheight
(* 0.8 textheight
(apply 'max
(cons (/ (strlen title) (length (car data)))
(mapcar 'strlen (apply 'append data))
)
)
)
)
)
(* 2.
(/
(setq textheight
(vla-gettextheight
(setq style
(vla-item
(vla-item
(vla-get-dictionaries (vla-get-document space)) "ACAD_TABLESTYLE"
)
(getvar 'CTABLESTYLE)
)
)
acdatarow
)
)
(if (_isAnnotative (vla-gettextstyle style acdatarow))
(cond ( (getvar 'CANNOSCALEVALUE) ) ( 1.0 ))
1.0
)
)
)
)
)
)
;;------------------------------------------------------------;;
;; End of File ;;
;;------------------------------------------------------------;;
(and (setq ss (ssget "_:L" '((0 . "LINE"))))
(while (setq en (ssname ss 0))
(setq ed (entget en))
(setq p10 (cdr (assoc 10 ed)))
(setq p11 (cdr (assoc 11 ed)))
(setq lyr (cdr (assoc 8 ed)))
(if
(= lyr "s-frm-group1")(setq data "GROUP 1"))
(ssdel en ss))) 看这个，第一部分制作一个表，（VLA-SETTEXT OBJTABLE Y 0（NTH X LIST1））这将一个值放入由Y和X值给定的行和列中。这个示例使用repeat获得一个值列表，在您的示例中（VLA-SETTEXT OBJTABLE Y 0 value1），如果Y是1，那么它的第一行，列0，（VLA-SETTEXT OBJTABLE Y 1 Value2）这是同一行，但是第二列。不要混淆，它是从0开始的。
; untested code but should create a table
(SETQ DOC (VLA-GET-ACTIVEDOCUMENT (VLAX-GET-ACAD-OBJECT)))
(SETQ CURSPACE (VLA-GET-PAPERSPACE DOC))
(SETQ PT1 (VLAX-3D-POINT (GETPOINT "\NPICK POINT FOR TOP LEFT HAND OF TABLE:")))
; NOW DO TABLE
(SETQ NUMROWS 4))
(SETQ NUMCOLUMNS 2)
(SETQ ROWHEIGHT 0.2)
(SETQ COLWIDTH 150)
(SETQ OBJTABLE (VLA-ADDTABLE CURSPACE PT1 NUMROWS NUMCOLUMNS ROWHEIGHT COLWIDTH))
(VLA-SETTEXT OBJTABLE 0 0 "DRAWING REGISTER") ; this top level
(VLA-SETTEXT OBJTABLE 1 0 "DRAWING NUMBER") ; 2nd line down 1st column
(VLA-SETTEXT OBJTABLE 1 1 "DRAWING TITLE") ; 2nd line down second column
; and this
(SETQ X 0)
(SETQ Y 2)
(REPEAT 4
(VLA-SETTEXT OBJTABLE Y 0 "value1")
(VLA-SETTEXT OBJTABLE Y 1 "value2")
(VLA-SETROWHEIGHT OBJTABLE Y 7)
(SETQ X (+ X 1))
(SETQ Y (+ Y 1))
)
Tharwat我找到了你为圆圈写的Lisp程序。如果它可以拉出线路信息，它将为我所需要的工作。
层名称长度数量
示例1 5’3
示例1 2’5
示例2 5’10
(defun c:Test (/ hgt spc d dia e ents inc increment Layers
insertionPoint tbl lengths lst r selectionset integer
selectionsetname
)
(vl-load-com)
;;; Tharwat 21 . June . 2012 ;;;
(if (not acdoc)
(setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
)
(setq spc (if (> (vla-get-activespace acdoc) 0)
(vla-get-modelspace acdoc)
(vla-get-paperspace acdoc)
)
)
(setq
hgt (if
(zerop
(cdr
(assoc
40
(setq
e (entget (tblobjname "STYLE" (getvar 'textstyle)))
)
)
)
)
(cdr (assoc 42 e))
(cdr (assoc 40 e))
)
)
(setq increment 1)
(if (setq selectionset (ssget (list '(0 . "CIRCLE"))))
(progn
(repeat (setq integer (sslength selectionset))
(setq selectionsetname
(ssname selectionset
(setq integer (1- integer))
)
)
(setq dia
(cons
(cons (* (cdr (assoc 40 (entget selectionsetname))) 2.)
(itoa increment)
)
dia
)
)
(setq ents (cons selectionsetname ents))
(setq increment (1+ increment))
)
)
)
(if (and dia
(setq insertionPoint (getpoint "\n Specify Table Location :"))
)
(progn
(setq tbl (vla-addtable
spc
(vlax-3d-point insertionPoint)
(+ (length dia) 2)
2
(* hgt 2.5)
(* hgt 2.5)
)
)
(setq inc -1
r 1
)
(repeat 2
(vla-setcolumnwidth tbl 0 (* hgt 10.))
(vla-setcolumnwidth tbl 1 (* hgt 10.))
(vla-setrowheight tbl (setq inc (1+ inc)) (* hgt 1.5))
)
(vla-settext tbl 0 0 "Circle's Diameters")
(vla-settext tbl 1 0 "Reference No.")
(vla-settext tbl 1 1 "Diameter Value")
(foreach x (reverse dia)
(vla-settext tbl (setq r (1+ r)) 0 (cdr x))
(vla-setcellalignment tbl r 0 acMiddleCenter)
(vla-settext tbl r 1 (rtos (car x) 2))
(vla-setcellalignment tbl r 1 acMiddleCenter)
)
(setq increment 1)
(foreach p (reverse ents)
(setq d (* (cdr (assoc 40 (entget p))) 2.))
(entmakex (list '(0 . "TEXT")
(assoc 10 (entget p))
(cons 11 (cdr (assoc 10 (entget p))))
(cons 40
(if (> increment 9)
(/ d 1.5)
(if (> hgt d)
d
hgt
)
)
)
(cons 1 (itoa increment))
'(72 . 1)
'(73 . 2)
)
)
(setq increment (1+ increment))
)
)
)
(princ "\n Written by Tharwat Al Shoufi")
(princ))
表代码的快速修改。
(defun Table (lst / acdoc hgt d inc p e tbl r c)
;;; Tharwat 11 . July . 2015 ;;;
(if (and lst
(setq p (getpoint "\n Specify Table Location :"))
)
(progn
(setq acdoc (vla-get-activedocument (vlax-get-acad-object))
hgt (if
(zerop
(cdr
(assoc
40
(setq
e
(entget (tblobjname "STYLE" (getvar 'textstyle))
)
)
)
)
)
(cdr (assoc 42 e))
(cdr (assoc 40 e))
)
tbl (vla-addtable
(vla-get-block (vla-get-activelayout acdoc))
(vlax-3d-point p)
(+ (length lst) 2)
3
(* hgt 2.5)
(* hgt 2.5)
)
inc -1
r 1
)
(vla-settext tbl 0 0 "Summary")
(vla-settext tbl 1 0 "Layer Name")
(vla-setcolumnwidth tbl 0 (* hgt 8.))
(vla-settext tbl 1 1 "Length")
(vla-setcolumnwidth tbl 1 (* hgt 6.))
(vla-settext tbl 1 2 "QTY")
(vla-setcolumnwidth tbl 2 (* hgt 4.))
(mapcar '(lambda (i) (vla-setrowheight tbl i (* hgt 1.5))) '(0 1))
(foreach v lst
(setq c -1
r (1+ r)
)
(foreach x v
(vla-settext tbl r (setq c (1+ c)) x)
(vla-setrowheight tbl r (* hgt 1.5))
(vla-setcellalignment tbl r c acMiddleCenter)
)
)
)
)
(princ)
)(vl-load-com)
用法：
(Table '(("a" "b" 1) ("c" "d" 2) ("e" "f" 3)))
塔尔瓦特，
谢谢你调整代码，但我做得还不够。我找到了这段多段线代码，并做了一些修改。但我还是得不到我需要的。我得到了我想要的3列。但我不知道如何让它在一行中添加相同的产品，并根据我选择的产品数量保持行添加。
层名称长度数量
示例1 5’3
示例1 2’5
示例2 5’10
(vl-load-com)
(defun C:mat ( / *MS* A CNT I LST MYTABLE PT1 ROW SSET TLST)
; create an empty list, set a counter variable, and
; set a reference to the current model space.
(setq lst '()
i 0
*ms* (vla-get-modelspace
(vla-get-activedocument
(vlax-get-acad-object)))
)
; prompt the user to select lines
(princ "\n Select closed lines ")
(if (setq sset (ssget "_:L" '((0 . "LINE");(-4 . "&")
;(70 . 1)
)))
(progn (setq en (ssname sset 0))
(setq ed (entget en))
(setq k (sslength sset))
(setq p10 (cdr (assoc 10 ed)))
(setq p11 (cdr (assoc 11 ed)))
(setq lyr (cdr (assoc 8 ed)))
(setq depth (cdr (assoc 39 ed)))
(setq mpt (mapcar '(lambda (a b) (* (+ a b) 0.5)) p10 p11))
(setq d2d (distance (cdr (reverse p10)) (cdr (reverse p11))))
(setq d1d (/ d2d 12.))
(setq d1c (fix d1d))
(if (> d1d d1c)
(setq d2c (+ d1c 1)))
(if (<= d1d d1c)
(setq d2c d1c))
(if
(= lyr "s-frm-blk")(setq lyr2 "BLK"))
(if
(= lyr "S-FRM-BLK")(setq lyr2 "BLK"))
; and store these values in a list.
(repeat (setq cnt (sslength sset))
(setq a (vlax-ename->vla-object (ssname sset i)))
(setq tlst (list (vla-get-length a) (vla-get-ObjectID a)))
(setq lst (cons tlst lst))
(setq i (1+ i))
)
; pick a point for the table
(setq pt1 (getpoint "\nPick point for table "))
; add the new table
(setq myTable (vla-AddTable
*ms*
(vlax-3d-point pt1)
(+ 3 cnt)
3
0.7
2.5))
; the next three lines set the header text
(vla-setText mytable 0 0 "Title")
(vla-setText mytable 1 0 "Length")
(vla-setText mytable 1 1 "Product")
(vla-setText mytable 1 2 "Qty")
(setq row 2)
; loop through the list of line properties
; adding a line to the table that contains the
; area and the length
(foreach item lst
(vla-setText mytable
row
0
(strcat "%<\\AcObjProp Object(%<\_ObjId " (itoa (last item)) ">%).Length \\f \"%lu4\">%"))
; (itoa d2c) )
(vla-setText mytable row 1 (last item))
(setq row (1+ row))
)
; product
(foreach item lst
(vla-setText mytable
row
1
(setq tch (strcat lyr2)))
(vla-setText mytable row 1 (last item))
(setq row (1+ row)))
;(strcat "Total=\\P"
;"%<\\AcExpr (Sum(A3:A" (itoa (+ 2 cnt)) ")) \\f \"%lu2\">%"))
; release "myTable" and *ms*
(vlax-release-object myTable)
(vlax-release-object *ms*)
); end progn
); end if
(princ)
); end defun
页:
[1]
2