Copy fields/texts between cells - local system

[regvac769251]

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

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

[Ed Jobe]

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.

[regvac769251]

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.

[regvac769251]

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?

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

[Opie]

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.

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

[regvac769251]

Thank you for your idea. here is my working final script.
PS:

 ...

could be added to the reply menu

; 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: "))
  )
)

[Opie]

Thank you for your idea. here is my working final script.
PS:

 ...

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.

[regvac769251]

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

[Ed Jobe]

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