See the top rated post in this thread. Click here

Results 1 to 9 of 9

Thread: Copy fields/texts between cells - local system

  1. #1
    Member
    Join Date
    2018-06
    Posts
    9
    Login to Give a bone
    0

    Default Copy fields/texts between cells - local system

    Hi, can anybody help me to change this script to work in any coordinate system? In global it work, in local not.

    Code:
    ; Copy fields/texts between cells
    (defun c:cfbc () ; VAC
      (setq obj (vlax-ename->vla-object (car (entsel "Pick table object"))))
      (while t
        (setq ans (vla-fieldcode (vlax-ename->vla-object (car (nentsel "\nSelect Cell to Copy Field/Text: ")))))
        (setq ins (getpoint "\nSelect Cell to Insert Field/Text: "))
        (setq ans1 (LM:Hittest ins (setq Tables (Getacadtableobjects))))
        (vla-settext obj (nth 1 ans1) (nth 2 ans1) ans)  
      )
    )
    
    (Defun LM:Hittest ( Pt Lst ) ; Lee Mac
          (If (And (Vl-consp Pt) (Vl-every 'Numberp Pt))
            (Vl-some
              (Function
                (Lambda ( O / R C )
                  (If (Eq :Vlax-true (Vla-hittest O (Vlax-3d-point (Trans Pt 1 0)) (Vlax-3d-point (Trans (Getvar 'Viewdir) 1 0)) 'R 'C)) (List O R C) )
                )
              )
              Lst
            )
          )
    )
    
    (defun LM:getattributevalues ( blk / enx ) ; Lee Mac
        (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk))))))
            (cons
                (cons
                    (cdr (assoc 2 enx))
                    (cdr (assoc 1 (reverse enx)))
                )
                (LM:getattributevalues blk)
            )
        )
    )
    Last edited by Opie; 2024-02-20 at 02:16 PM. Reason: [code] tags added

  2. #2
    Administrator Ed Jobe's Avatar
    Join Date
    2000-11
    Location
    Turlock, CA
    Posts
    6,420
    Login to Give a bone
    0

    Default Re: Copy fields/texts between cells - local system

    What do you mean by global and local? There are no such coordinate systems. There is world and User Coordinate Systems or UCS's. To convert a point from one coordinate system to another use the trans function.

    However, I can't imagine why you would put a table in a ucs. Most textual entities are in paper space, wcs.
    C:> ED WORKING....


    LinkedIn

  3. #3
    Member
    Join Date
    2018-06
    Posts
    9
    Login to Give a bone
    0

    Default Re: Copy fields/texts between cells - local system

    Oh yes, sorry, I mean WCS and UCS. Script works only in WCS. We draw some project in UCS and some in WCS. Can you help me with it? I do not understand LISP syntax....Thank you

    - - - Updated - - -

    And I found out that LM:getattributevalues is in this script unnecessary.

  4. #4
    Member
    Join Date
    2018-06
    Posts
    9
    Login to Give a bone
    0

    Default Re: Copy fields/texts between cells - local system

    I've tried this - I temporarily changed the coordinate system. It works, but I can't end the while cycle (if I do not want to copy another cell) and return the variables and UCS to their original state after this break. Can you advise?

    Code:
    ; Copy fields/texts between cells
    (defun c:cfbcg () ; VAC
      (Defun LM:Hittest ( Pt Lst ) ; Lee Mac
        (If (And (Vl-consp Pt) (Vl-every 'Numberp Pt))
          (Vl-some
            (Function
              (Lambda ( O / R C )
                (If (Eq :Vlax-true (Vla-hittest O (Vlax-3d-point (Trans Pt 1 0)) (Vlax-3d-point (Trans (Getvar 'Viewdir) 1 0)) 'R 'C)) (List O R C) )
              )
            )
            Lst
          )
        )
      ) 
     
      (setq original-ucsfollow (getvar 'ucsfollow))
      (if (= original-ucsfollow 1)
        (setvar 'ucsfollow 0)
      )
      (setvar 'cmdecho 0)
      (command "_UCS" "_W" "")
      (setvar 'cmdecho 1)
      (setq obj (vlax-ename->vla-object (car (entsel "Pick table object"))))
      (while t
        (setq ans (vla-fieldcode (vlax-ename->vla-object (car (nentsel "\nSelect Cell to Copy Field/Text: ")))))
        (setq ins (getpoint "\nSelect Cell to Insert Field/Text: "))
        (setq ans1 (LM:Hittest ins (setq Tables (Getacadtableobjects))))
        (vla-settext obj (nth 1 ans1) (nth 2 ans1) ans)  
      ) 
      (progn
        (if (= original-ucsfollow 1)
          (setvar 'ucsfollow 1)
        )
        (setvar 'cmdecho 0)
        (command "_UCS" "_PREVIOUS" "")
        (setvar 'cmdecho 1)
      )
    )
    Last edited by Opie; 2024-02-22 at 01:17 PM. Reason: [code] tags added

  5. #5
    Administrator Opie's Avatar
    Join Date
    2002-01
    Location
    jUSt Here (a lot)
    Posts
    9,106
    Login to Give a bone
    1

    Default Re: Copy fields/texts between cells - local system

    You'll never exit the while when the evaluation check always returns true. Your while section probably needs to be reworked a bit. You could pull the nentsel function out to set a variable for the while evaluation check some to evaluate that could change to false.

    Something like this may work.
    Code:
    (setq pick (nentsel "\nSelect Cell to Copy Field/Text: "))
    (while pick
      (setq ans (vla-fieldcode (vlax-ename->vla-object (car pick))))
      ;| The rest of that while code you have |;
      (setq pick (nentsel "\nSelect Cell to Copy Field/Text: "))
    )
    Also, please surround your code with [code] ... [/code] tags.
    If you have a technical question, please find the appropriate forum and ask it there.
    You will get a quicker response from your fellow AUGI members than if you sent it to me via a PM or email.
    jUSt

  6. #6
    Member
    Join Date
    2018-06
    Posts
    9
    Login to Give a bone
    1

    Default Re: Copy fields/texts between cells - local system

    Thank you for your idea. here is my working final script.
    PS:
    Code:
     ...
    could be added to the reply menu

    Code:
    ; Copy fields/texts between cells
    (defun c:cfbcg () ; VAC
      (Defun LM:Hittest ( Pt Lst ) ; Lee Mac
        (If (And (Vl-consp Pt) (Vl-every 'Numberp Pt))
          (Vl-some
            (Function
              (Lambda ( O / R C )
                (If (Eq :Vlax-true (Vla-hittest O (Vlax-3d-point (Trans Pt 1 0)) (Vlax-3d-point (Trans (Getvar 'Viewdir) 1 0)) 'R 'C)) (List O R C) )
              )
            )
            Lst
          )
        )
      ) 
     
      (setq obj (vlax-ename->vla-object (car (entsel "Pick table object"))))
      (setq pick (nentsel "\nSelect Cell to Copy Field/Text: "))
      (while pick
        (setq original-ucsfollow (getvar 'ucsfollow))
        (if (= original-ucsfollow 1)
          (setvar 'ucsfollow 0)
        )
        (setvar 'cmdecho 0)
        (command "_UCS" "_W" "")
        (setvar 'cmdecho 1)
        (setq ans (vla-fieldcode (vlax-ename->vla-object (car pick))))
        (setq ins (getpoint "\nSelect Cell to Insert Field/Text: "))
        (setq ans1 (LM:Hittest ins (setq Tables (Getacadtableobjects))))
        (vla-settext obj (nth 1 ans1) (nth 2 ans1) ans)  
        (if (= original-ucsfollow 1)
          (setvar 'ucsfollow 1)
        )
        (setvar 'cmdecho 0)
        (command "_UCS" "_PREVIOUS" "")
        (setvar 'cmdecho 1)
        (setq pick (nentsel "\nSelect Cell to Copy Field/Text: "))
      )
    )

  7. #7
    Administrator Opie's Avatar
    Join Date
    2002-01
    Location
    jUSt Here (a lot)
    Posts
    9,106
    Login to Give a bone
    0

    Default Re: Copy fields/texts between cells - local system

    Quote Originally Posted by regvac769251 View Post
    Thank you for your idea. here is my working final script.
    PS:
    Code:
     ...
    could be added to the reply menu
    It is available in the Go Advanced screen when making posts. It is shown as a # button on that page. Or you could just type [code] at the beginning of your code and [/code] at the end of your code.
    If you have a technical question, please find the appropriate forum and ask it there.
    You will get a quicker response from your fellow AUGI members than if you sent it to me via a PM or email.
    jUSt

  8. #8
    Member
    Join Date
    2018-06
    Posts
    9
    Login to Give a bone
    0

    Default Re: Copy fields/texts between cells - local system

    I'm sorry but I see only this:
    img.JPG

  9. #9
    Administrator Ed Jobe's Avatar
    Join Date
    2000-11
    Location
    Turlock, CA
    Posts
    6,420
    Login to Give a bone
    0

    Default Re: Copy fields/texts between cells - local system

    The Go Advanced button is in the lower right after you click on the Reply button. Then select your code and click on the # button to wrap code tags. If you don't use Go Advanced, you can always just type the code tags "[code] ... [/code]"
    augi go advanced.png
    C:> ED WORKING....


    LinkedIn

Similar Threads

  1. Grouped schedules - non-empty cells in different color as empty cells
    By Wish List System in forum Revit Architecture - Wish List
    Replies: 0
    Last Post: 2015-12-14, 01:33 PM
  2. Local Files: program to delete local file and create a new local file
    By mailshanegross in forum Revit - Worksharing/Worksets/Revit Server
    Replies: 4
    Last Post: 2009-06-03, 02:29 AM
  3. Copy Multiple Cells in Block Editor
    By autocad.wishlist1734 in forum AutoCAD Wish List
    Replies: 0
    Last Post: 2007-11-28, 04:49 PM
  4. Multiplication of Fields in Table cells
    By Nishchay Bhuta in forum VBA/COM Interop
    Replies: 0
    Last Post: 2007-03-29, 10:25 AM
  5. AutoCAD 2006 - Minus cells between two tables
    By tyeelaw13 in forum AutoCAD Tables
    Replies: 3
    Last Post: 2006-09-14, 12:47 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •