Jump to content

Need help excluding an attribute from LISP script


Janouren

Recommended Posts

Hello,

I've found the perfect LISP script for optimising my work, except It needs to be modified a little. My job is replacing all blocks on a drawing that have names HUP_1, HUP_2...HUP_300 with a single other block called HUP_S. This script does that, which is excellent, however, it copies rotation from the block that replaces the old ones. I need to replace all blocks, but keep their original rotation on the drawing. Could anyone please help me modifying the script so it does that? (also, Im new to this forum and it's fantastic. Found plenty of useful workflow optimisations) Here it is:

(defun c:BRE (/ *error* blk f ss temp)
 ;; Replace multiple instances of selected blocks (can be different) with selected block
 ;; Size and Rotation will be taken from original block and original will be deleted
 ;; Required subroutines: AT:GetSel
 ;; Alan J. Thompson, 02.09.10

 (vl-load-com)

 (defun *error* (msg)
   (and f *AcadDoc* (vla-endundomark *AcadDoc*))
   (if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
     (princ (strcat "\nError: " msg))
   )
 )

 (if
   (and
     (AT:GetSel
       entsel
       "\nSelect replacement block: "
       (lambda (x / e)
         (if
           (and
             (eq "INSERT" (cdr (assoc 0 (setq e (entget (car x))))))
             (/= 4 (logand (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 e))))) 4))
             (/= 4 (logand (cdr (assoc 70 (entget (tblobjname "LAYER" (cdr (assoc 8 e)))))) 4))
           )
            (setq blk (vlax-ename->vla-object (car x)))
         )
       )
     )
     (princ "\nSelect blocks to be repalced: ")
     (setq ss (ssget "_:L" '((0 . "INSERT"))))
   )
    (progn
      (setq f (not (vla-startundomark
                     (cond (*AcadDoc*)
                           ((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
                     )
                   )
              )
      )
      (vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
        (setq temp (vla-copy blk))
        (mapcar (function (lambda (p)
                            (vl-catch-all-apply
                              (function vlax-put-property)
                              (list temp p (vlax-get-property x p))
                            )
                          )
                )
                '(Insertionpoint XEffectiveScaleFactor YEffectiveScaleFactor
                  ZEffectiveScaleFactor
                 )
        )
        (vla-delete x)
      )
      (vla-delete ss)
      (*error* nil)
    )
 )
 (princ)
)

(defun AT:GetSel (meth msg fnc / ent good)
 ;; meth - selection method (entsel, nentsel, nentselp)
 ;; msg - message to display (nil for default)
 ;; fnc - optional function to apply to selected object
 ;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
 ;; Alan J. Thompson, 05.25.10
 (setvar 'errno 0)
 (while (not good)
   (setq ent (meth (cond (msg)
                         ("\nSelect object: ")
                   )
             )
   )
   (cond
     ((vl-consp ent)
      (setq good (cond ((or (not fnc) (fnc ent)) ent)
                       ((prompt "\nInvalid object!"))
                 )
      )
     )
     ((eq (type ent) 'STR) (setq good ent))
     ((setq good (eq 52 (getvar 'errno))) nil)
     ((eq 7 (getvar 'errno)) (setq good (prompt "\nMissed, try again.")))
   )
 )
)


 

Link to comment
Share on other sites

untested but have you tried adding 'Rotation' to the proplist? so change :

 

  '(Insertionpoint XEffectiveScaleFactor YEffectiveScaleFactor ZEffectiveScaleFactor) 

to

  '(Insertionpoint XEffectiveScaleFactor YEffectiveScaleFactor ZEffectiveScaleFactor Rotation) 

  • Thanks 1
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...