字段编辑或字段输入自动

KAPC · 发表于 2022-7-6 06:29:37

我有几个带有字段的长表，我想自动输入这些字段的数据，这样我就不必每次都选择字段类型/属性/格式。

有谁能帮助我使用命令/lisp例程“编辑字段”（表中的重复字段）并将所述字段更改为：

（1）物体测量数据*
或（2）对象区域数据*

只需选择对象并绕过类型、属性、格式等的选择。

（*=实际上可能需要两个不同的例程）

或者，一个更简单的命令/lisp例程将在图形上插入一个包含上述数据（测量值/面积）的字段，然后我可以将其复制并粘贴到表格单元格中。

非常感谢！

Lee Mac · 发表于 2022-7-6 06:39:03

此线程可能会有所帮助

http://www.cadtutor.net/forum/showthread.php?t=38009

如果你在那里找不到你想要的东西，我很乐意帮助更多人

Lee Mac · 发表于 2022-7-6 06:43:13

试试这个：

copy


;; 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 [sel/Poly/Quit] <" *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))

KAPC · 发表于 2022-7-6 06:51:50

谢谢，除了属性“测量”之外，这似乎有效。如何将其添加到例程中？

Lee Mac · 发表于 2022-7-6 06:55:49

“测量”？至于尺寸？

你还需要周长吗？

KAPC · 发表于 2022-7-6 07:00:42

我不需要长度/周长。“面积”字段与工作正常的物理对象相关，但在选择与对象相关的维度时，我需要一个“测量”字段。

我的表格基本上包括显示面积是如何计算的，因此我需要将尺寸输入（链接）表格的“等式侧”，将面积输入“总侧”。

KAPC · 发表于 2022-7-6 07:10:45

我认为面积数字必须准确，但相反，它们必须与计算完全匹配（精度合理）。在这方面，我实际上必须让Autocad计算公式，并且只输入与测量值连接的字段。见附表示例。

我喜欢这个例程的工作方式，你能通过询问“测量”属性来帮助简化例程吗？换句话说，选择维度，放置在表/单元格中？

顺便说一句，我自己也试着改变程序，但我不断得到无效的对象或错误。。。

Lee Mac · 发表于 2022-7-6 07:17:23

试试这个：

copy


(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))

KAPC · 发表于 2022-7-6 07:18:08

这真的不起作用。出于某种原因，它插入了维度值，后跟“\ X”。
无论如何，输入值是文本，并且确实需要是一个字段，就像您之前的区域、长度字段例程一样。

Lee Mac · 发表于 2022-7-6 07:29:24

嗨，卡普，

终于有机会看到这个了，试一试：

copy


(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))

李

[编程交流] 字段编辑或字段输入自动

发表回复

精选推荐