字段编辑或字段输入自动
我有几个带有字段的长表，我想自动输入这些字段的数据，这样我就不必每次都选择字段类型/属性/格式。有谁能帮助我使用命令/lisp例程“编辑字段”（表中的重复字段）并将所述字段更改为：
（1） 物体测量数据*
或（2）对象区域数据*
只需选择对象并绕过类型、属性、格式等的选择。
（*=实际上可能需要两个不同的例程）
或者，一个更简单的命令/lisp例程将在图形上插入一个包含上述数据（测量值/面积）的字段，然后我可以将其复制并粘贴到表格单元格中。
非常感谢！ 此线程可能会有所帮助
http://www.cadtutor.net/forum/showthread.php?t=38009
如果你在那里找不到你想要的东西，我很乐意帮助更多人 试试这个：
;; Put Field in Cell, by Lee McDonnell 11.07.2009
(defun c:putfld (/ *error* doc spc chx ent Obj tStr flag
grdat gr dat osPt tss lst row col)
(vl-load-com)
(defun *error* (msg)
(and tObj
(not
(vlax-erased-p tObj))
(vla-delete tObj))
(if (not
(wcmatch
(strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
(princ
(strcat
"\n<< Error: " msg " >>"))
(princ "\n*Cancel*"))
(princ))
(setq doc (vla-get-ActiveDocument
(vlax-get-Acad-Object))
spc (if
(zerop
(vla-get-activespace doc))
(if (= (vla-get-mspace doc) :vlax-true)
(vla-get-modelspace doc) ; Vport
(vla-get-paperspace doc))
(vla-get-modelspace doc)))
(or *mac (setq *mac "Select"))
(while
(progn
(initget "Select Polyline Quit")
(setq chx
(getkword
(strcat "\nSelect Object or Draw Polyline <" *mac "> : ")))
(or (not chx) (setq *mac chx))
(setq flag nil)
(cond
((eq "Quit" chx) nil)
(t
(cond
((eq "Select" *mac)
(while
(progn
(setq ent (car (entsel "\nSelect Object: ")))
(cond
((eq 'ENAME (type ent))
(if
(not
(and
(vlax-property-available-p
(setq Obj
(vlax-ename->vla-object ent)) 'Area)
(vlax-property-available-p Obj 'Length)))
(princ "\n** Invalid Object Selected **")))
(t (princ "\n** Nothing Selected **"))))))
((eq "Polyline" *mac)
(command "_.pline")
(while
(eq 1
(logand 1
(getvar 'CMDACTIVE)))
(command pause))
(setq Obj
(vlax-ename->vla-object
(entlast)))))
(if Obj
(progn
(repeat 2
(setq tStr
(strcat
"%<\\AcObjProp.16.2 Object(%<\\_ObjId "
(vl-princ-to-string
(vla-get-Objectid Obj)) ">%)."
(if flag "Length" "Area")
" \\f \"%lu2%pr2\">%"))
(setq tObj
(vla-addMText spc
(vlax-3D-point '(0 0 0)) 0 tStr))
(vla-put-visible tObj :vlax-false)
(princ
(strcat
"\nPlace " (if flag "Length" "Area") " Field..."))
(while
(progn
(setq grdat (grread t 15 0)
gr (car grdat) dat (cadr grdat))
(cond
((and (eq 5 gr) (listp dat))
(redraw)
(vla-put-visible tObj :vlax-true)
(vla-move tObj
(vla-get-InsertionPoint tObj)
(vlax-3D-point dat))
t)
((eq 2 gr)
(cond
((vl-position dat '(32 13))
nil)
(t t)))
((eq 25 gr)
(and tObj
(not
(vlax-erased-p tObj))
(vla-delete tObj))
nil)
((eq 3 gr)
(if
(and
(setq tss
(ssget "_X" '((0 . "ACAD_TABLE"))))
(setq lst (car
(vl-remove-if 'null
(mapcar
(function
(lambda (tab)
(if
(eq :vlax-true
(vla-HitTest tab
(vlax-3D-point
(trans dat 1 0))
(vlax-3D-point
(trans
(getvar 'VIEWDIR) 1 0)) 'row 'col))
(list tab row col))))
(mapcar 'vlax-ename->vla-object
(mapcar 'cadr (ssnamex tss))))))))
(and
(not
(apply 'vla-SetText
(append lst (list tStr)))) tObj
(not (vlax-erased-p tObj))
(vla-delete tObj)))
nil)
(t t))))
(setq flag T))))))))
(princ))
谢谢，除了属性“测量”之外，这似乎有效。如何将其添加到例程中？
“测量”？至于尺寸？
你还需要周长吗？ 我不需要长度/周长。“面积”字段与工作正常的物理对象相关，但在选择与对象相关的维度时，我需要一个“测量”字段。
我的表格基本上包括显示面积是如何计算的，因此我需要将尺寸输入（链接）表格的“等式侧”，将面积输入“总侧”。 我认为面积数字必须准确，但相反，它们必须与计算完全匹配（精度合理）。在这方面，我实际上必须让Autocad计算公式，并且只输入与测量值连接的字段。见附表示例。
我喜欢这个例程的工作方式，你能通过询问“测量”属性来帮助简化例程吗？换句话说，选择维度，放置在表/单元格中？
顺便说一句，我自己也试着改变程序，但我不断得到无效的对象或错误。。。
试试这个：
(defun c:dval (/ COL ENT I LST OBJ OBJLST PT ROW SS)
;; Place Dimension Value in Cell~Lee Mac 03.01.10
(vl-load-com)
(if (setq i -1 ss (ssget "_X" '((0 . "ACAD_TABLE"))))
(progn
(while (setq ent (ssname ss (setq i (1+ i))))
(setq objLst (cons (vlax-ename->vla-object ent) objLst)))
(while
(progn
(setq ent (car (entsel "\nSelect Dimension or Text <Exit> : ")))
(cond ((eq 'ENAME (type ent))
(if (not
(wcmatch
(vla-get-ObjectName
(setq obj (vlax-ename->vla-object ent))) "*Dimension,*Text"))
(princ "\n** Object Must be a Dimension or Text **")
(while
(progn
(setq pt (getpoint "\nPick inside Cell to Place Text: "))
(cond ((not pt))
((setq lst
(car
(vl-remove-if (function null)
(mapcar
(function
(lambda (table)
(if (eq :vlax-true
(vla-HitTest table
(vlax-3D-point (trans pt 1 0))
(vlax-3D-point
(trans
(getvar 'VIEWDIR) 1 0)) 'row 'col))
(list table row col))))
ObjLst))))
(apply
(function vla-SetText)
(append lst
(list
(cond ((wcmatch (vla-get-Objectname obj) "*Dimension")
(strcat
(vla-get-TextPrefix obj)
(rtos (vla-get-Measurement obj)
(vla-get-UnitsFormat obj)
(vla-get-PrimaryUnitsPrecision obj))
(vla-get-TextSuffix obj)))
((vla-get-TextString obj)))))) nil)
(t (princ "\n** Point must be inside Cell **")))))) t)))))
(princ "\n** No Tables Found in Drawing **"))
(princ))
这真的不起作用。出于某种原因，它插入了维度值，后跟“\ X”。
无论如何，输入值是文本，并且确实需要是一个字段，就像您之前的区域、长度字段例程一样。 嗨，卡普，
终于有机会看到这个了，试一试：
(defun c:Dim2Cell (/ *error*
CODE COL DATA ENT GR I LST OBJ
ROW SPC TLST TOBJ TSS TSTR UFLAG)
(vl-load-com)
;; Lee Mac~17.02.10
(defun *error* (msg)
(and uFlag (vla-EndUndoMark *doc))
(and tObj (not (vlax-erased-p tObj))
(vla-delete tObj))
(or (not msg)
(wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))
(setq *doc (cond (*doc) ((vla-get-ActiveDocument
(vlax-get-acad-object))))
spc(if (zerop (vla-get-activespace *doc))
(if (= (vla-get-mspace *doc) :vlax-true)
(vla-get-modelspace *doc)
(vla-get-paperspace *doc))
(vla-get-modelspace *doc)))
(if (setq i -1 tss (ssget "_X" '((0 . "ACAD_TABLE"))))
(while (setq ent (ssname tss (setq i (1+ i))))
(setq tLst (cons (vlax-ename->vla-object ent) tLst))))
(while
(progn
(setq ent (car (entsel "\nSelect Dimension to Retrieve Measurement: ")))
(cond ((eq 'ENAME (type ent))
(if (vlax-property-available-p
(setq obj (vlax-ename->vla-object ent)) 'Measurement)
(progn
(setq uFlag (not (vla-StartUndoMark *doc)))
(setq tStr (strcat "%<\\AcObjProp Object(%<\\_ObjId "
(itoa (vla-get-ObjectId Obj))
">%).Measurement \\f \"%lu6\">%"))
(vla-put-AttachmentPoint
(setq tObj (vla-AddMText spc
(vlax-3D-point '(0 0 0)) 0 tStr))
acAttachmentPointMiddleCenter)
(while
(progn
(setq gr (grread 't 13 0) code (car gr) data (cadr gr))
(cond ((and (= 5 code) (listp data))
(vla-put-InsertionPoint tObj (vlax-3D-point data))
t)
((= 25 code)
(and tObj (not (vlax-erased-p tObj))
(vla-delete tObj))
nil)
((and (= 3 code) (listp data))
(cond ((setq lst
(car
(vl-remove-if 'null
(mapcar
(function
(lambda (table)
(if (eq :vlax-true
(vla-hittest table
(vlax-3D-point
(trans data 1 0))
(vlax-3D-point
(trans
(getvar 'VIEWDIR) 1 0))
'row 'col))
(list table row col))))
tLst))))
(apply (function vla-SetText)
(append lst (list tStr)))
(and tObj (not (vlax-erased-p tObj))
(vla-delete tObj))))
nil)
(t ))))
(setq uFlag (vla-EndUndoMark *doc)))
(princ "\n** Object Does not Have Measurement Property **"))))))
(princ))
李
页:
[1]
2