Author Topic: Lisp to Swap textstring between 2 Blocks, Not Working  (Read 3198 times)

0 Members and 1 Guest are viewing this topic.

HasanCAD

  • Swamp Rat
  • Posts: 1422
Lisp to Swap textstring between 2 Blocks, Not Working
« on: January 26, 2011, 09:34:54 AM »
Please help
This lisp not working
Code: [Select]
(defun c:StSwap (/ doc spc)
  (vl-load-com)

  (defun *error* ( msg ) (and doc (_EndUndo doc)) (or (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 DocActv (/ doc spc ) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq spc (if (or (eq AcModelSpace (vla-get-ActiveSpace doc)) (eq :vlax-true   (vla-get-MSpace doc))) (vla-get-ModelSpace doc) (vla-get-PaperSpace doc))))

  (setq ATT1 (car (nentsel "\nSelect attribute1: ")))
  (SETQ ATT1VL (vlax-ename->vla-object ATT1))
  (SETQ ATT1STR (VLA-GET-TEXTSTRING ATT1VL))

  (setq ATT2 (car (nentsel "\nSelect attribute2: ")))
  (SETQ ATT2VL (vlax-ename->vla-object ATT2))
  (SETQ ATT2STR (vla-put-TextString doc ATT2VL))

  )

Lee Mac

  • Seagull
  • Posts: 12914
  • London, England

Lee Mac

  • Seagull
  • Posts: 12914
  • London, England
Re: Lisp to Swap textstring between 2 Blocks, Not Working
« Reply #2 on: January 26, 2011, 11:35:01 AM »
Code: [Select]
(SETQ ATT2STR (vla-put-TextString doc ATT2VL))
This will cause your error - you are trying to modify a non-existent TextString property of the Document Object.

Better perhaps:

Code: [Select]
(vla-put-TextString ATT2VL ATT1STR)

Tharwat

  • Swamp Rat
  • Posts: 710
  • Hypersensitive
Re: Lisp to Swap textstring between 2 Blocks, Not Working
« Reply #3 on: January 26, 2011, 11:50:00 AM »
Please help
This lisp not working
Code: [Select]
(defun c:StSwap (/ doc spc)
  (vl-load-com)

  (defun *error* ( msg ) (and doc (_EndUndo doc)) (or (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 DocActv (/ doc spc ) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq spc (if (or (eq AcModelSpace (vla-get-ActiveSpace doc)) (eq :vlax-true   (vla-get-MSpace doc))) (vla-get-ModelSpace doc) (vla-get-PaperSpace doc))))

  (setq ATT1 (car (nentsel "\nSelect attribute1: ")))
  (SETQ ATT1VL (vlax-ename->vla-object ATT1))
  (SETQ ATT1STR (VLA-GET-TEXTSTRING ATT1VL))

  (setq ATT2 (car (nentsel "\nSelect attribute2: ")))
  (SETQ ATT2VL (vlax-ename->vla-object ATT2))
  (SETQ ATT2STR (vla-put-TextString doc ATT2VL))

  )

What is the goal of that routine ?

HasanCAD

  • Swamp Rat
  • Posts: 1422
Re: Lisp to Swap textstring between 2 Blocks, Not Working
« Reply #4 on: January 27, 2011, 05:02:00 AM »
...
Better perhaps:
...
Working  :-)
Thanks

HasanCAD

  • Swamp Rat
  • Posts: 1422
Re: Lisp to Swap textstring between 2 Blocks, Not Working
« Reply #5 on: March 30, 2011, 07:00:41 PM »
Is there a wy to code this lisp in a better way
Code: [Select]
(defun c:SX (/ doc spc)
  (vl-load-com)
 
  (defun *error* ( msg ) (and doc (_EndUndo doc)) (or (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 DocActv (/ doc spc ) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (setq spc (if (or (eq AcModelSpace (vla-get-ActiveSpace doc)) (eq :vlax-true   (vla-get-MSpace doc))) (vla-get-ModelSpace doc) (vla-get-PaperSpace doc))))

  (defun LM:SetAttributeValue ( block tag value )
  ;; © Lee Mac 2010 - with some change by HasanCAD
  (vl-some (function (lambda ( attrib ) (if (eq tag (vla-get-TagString attrib)) (progn (vla-put-TextString attrib value) value)))) (vlax-invoke block 'GetAttributes)))

  (defun LM:GetAttributestxt ( block )
  ;; © Lee Mac 2010 - with some change by HasanCAD
  (mapcar (function (lambda ( attrib ) (vla-get-TextString attrib))) (vlax-invoke block 'GetAttributes)))

(defun LM:GetAttributestag ( block )
  ;; © Lee Mac 2010 - with some change by HasanCAD
  (mapcar (function (lambda ( attrib ) (vla-get-TagString attrib))) (vlax-invoke block 'GetAttributes)))

  (while
    (setq stVLs (VLA-GET-TEXTSTRING
  (vlax-ename->vla-object (car (nentsel "\nSelect AxisNo: ")))))

    (if (setq ss (ssget '((0 . "INSERT") (66 . 1))))
      (repeat (setq i (sslength ss))
(setq blk (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
(setq blktag (nth 0 (LM:GetAttributestag blk)))
(setq blktxt (nth 0 (LM:GetAttributestxt blk)))

(setq BlkValue (strcat stVLs "-" blkTxt))
(LM:SetAttributeValue blk blktag BlkValue)
)
      )
    )
  )

chlh_jd

  • Guest
Re: Lisp to Swap textstring between 2 Blocks, Not Working
« Reply #6 on: April 04, 2011, 10:38:30 PM »
hi all , to copy from block , I use this
Code: [Select]
;;; Nentsel
;;; function : to nentsel a entity In situ
;;; arg      : string to princ in command-line
;;; return   : a list ( ename point is-of-block? )
;;; Note     : if the ename is of a block , the routine copy a
;;;             similar entity , so you must entdel it later .
;;; by GSLS(SS)
;;;
(defun ss-Nentsel (msg / en en1 pt mat ins mat ent)
  (setq en (Nentsel msg))
  (if (= (length en) 4)
    (progn
      (setq en1 (car en)
    pt (cadr en)
    mat (caddr en)
    ins (last mat)
    mat (reverse (cdr (reverse mat)))
    mat (append
  (mapcar '(lambda (x y)
     (append x (list y))
   )
  mat
  ins
  )
  '((0. 0. 0. 1.))
)
    ent (entget en1 '("*"))
    ent (vl-remove (assoc -1 ent) ent)
    en1 (entmakex ent)
      )
      (if en1
(progn
  (setq obj (vlax-ename->vla-object en1))
  (vla-TransformBy obj (vlax-tmatrix mat))
  (setq en1 (vlax-vla-object->ename obj))
)
      )
      (list en1 pt T)
    )
    (append en (list nil))
  )
)