Topic: can anyone help with a more elegant way to do this?

[andrew_nao]

im lookin for a more elegant way to take an old block, remove it completely from the dwg and insert a new block and update the attribute
this works, but im looking for a more smaller (in code length), elegant and simple way to do this because this will be incorporated into another lisp function

any help or guidance is appreciated

Code: [Select]

(defun ub (/ oldblock_lst newblock_lst c oblk nblk olay ss ent elist x ip nlay)
(SETQ DS (GETVAR "DIMSCALE"))
(setq jobno(substr (vl-Filename-Base (vl-Filename-Directory (getvar "Dwgprefix")))1 6))
(setvar "cmdecho" 0)
(setq oldblock_lst (list (strcase "l-89-1") (strcase "l-89-2") (strcase "l-89-3")
                         (strcase "l-89-5") (strcase "tag-l") (strcase "tag-m")
                         (strcase "tag-s") (strcase "naotag-l") (strcase "naotag-m")
                         (strcase "naotag-s")
                   )
)
(setq newblock_lst (list (strcase "naotag-l") (strcase "naotag-l") (strcase "naotag-m")
                         (strcase "naotag-s") (strcase "naotag-l") (strcase "naotag-m")
                         (strcase "naotag-s") (strcase "naotag-l") (strcase "naotag-m")
                         (strcase "naotag-s")
                   )
)
(setq C 0)
(repeat 10
(setq oblk (nth C oldblock_lst)
      nblk (nth C newblock_lst)
)
(command "_purge" "B" oblk "n")     ; purge block if not visible

(if (tblsearch "block" oblk)
;;
  (progn
   (setvar "cmdecho" 0)
   (setq olay (getvar "clayer"))
   (setq ss (ssget "X" (list (cons 2 oblk))))
   (setq ent (ssname ss 0)) ;
   (setq elist (entget ent)) ; entity list
   (setq x (cdr (assoc 41 elist))) ; Scale
   (setq ip (cdr (assoc 10 elist))) ; Insertion point
   (setq nlay (cdr (assoc 8 elist))) ; Get Block Layer
   (setq rot (cdr (assoc 50 elist))) ; Get rotation in radians
   (setq oldrot (/ (* rot 180) pi))     ; convert radian to degrees

     (if ss
      (progn
        (setvar "cmdecho" 0)
        (command "_erase" ss "")                      ; erase block
        (command "_purge" "B" oblk "n")         ; purge block
        (command "_layer" "S" nlay "")         ; make old block layer current
        (command "-insert" nblk ip x "" oldrot jobno)     ; insert new block
(command "_layer" "S" olay "")         ; reset layer
      ) ; progn
    ) ;if ss
  ) ;progn

;;
); if
(setq C (+ C 1))
); repeat


)

(ub)
  (princ)
(setvar "cmdecho" 1)



[Lee Mac]

For one thing, replace all of:

Code: [Select]

(strcase "naotag-l")
with:

Code: [Select]

"NAOTAG-L"

[andrew_nao]

For one thing, replace all of:

Code: [Select]

(strcase "naotag-l")
with:

Code: [Select]

"NAOTAG-L"

well some blocks are lower case and some arent, dont ask me why its like this, i dont know but it is.

[dgorsman]

With block names, it shouldn't matter.  But if still necessary, plug the strings into the list as you like and use (mapcar...) to apply the strcase over the full list.  Same result, less code, and less chance of missing one.

Using the block names in a dotted pair list (("old name1" . "new name2")("old name2" . "new name1") etc.) might be a little easier to match up, but commonly indexed lists work just as well.

Its something of a style factor for me, but I prefer to use (while...) over (repeat...) since it allows for additional loop tests beyond the index counter.

[uncoolperson]

I'd go with a
seperate defun for the swapping (two variables, existing name, new name)... might come in handy somewhere down the line

dotted list of entries
mapcar to trim list to only the blocks required to modify (those in the drawing)
a foreach using apply(I think apply is what I'm thinking of) (maybe with a grdraw bulldozer appearing over each instance)

[andrew_nao]

With block names, it shouldn't matter.  But if still necessary, plug the strings into the list as you like and use (mapcar...) to apply the strcase over the full list.  Same result, less code, and less chance of missing one.

i dont understand, how do you use mapcar to apply a strcase over a whole list?

[andrew_nao]

maybe this has an answer, the last line of this snippet
where "blockname" is, how can i get the variable "oldblock" to work in there?

Code: [Select]

   (setq ent (ssname ent1 0))
   (setq elist (entget ent))
   (setq x (cdr (assoc 41 elist))) ; Scale
   (setq ip (cdr (assoc 10 elist))) ; Insertion point
   (setq nlay (cdr (assoc 8 elist))) ; Get Block Layer
   (setq rot (cdr (assoc 50 elist))) ; Get rotation in radians
   (setq oldrot (/ (* rot 180) pi))     ; convert radian to degrees   
   (setq oldblock (cdr (assoc 2 elist)))
   

   (if (assoc oldblock oldblock_lst)
   (progn
     (setq ent1 (ssget "_X" '((0 . "INSERT") (2 . "blockname" ))))


[uncoolperson]

no autocad infront of me at the moment, so probably not 100%

(setq uppercase_stuff (mapcar 'strcase lower_case_stuff))


(setq ent1 (ssget "_X" (list '(0 . "INSERT") (cons 2  oldblock ))))

[andrew_nao]

no autocad infront of me at the moment, so probably not 100%

(setq uppercase_stuff (mapcar 'strcase lower_case_stuff))


(setq ent1 (ssget "_X" (list '(0 . "INSERT") (cons 2  oldblock ))))

thanks for the help, however the first isnt working

[uncoolperson]

_$ (setq lower_case_stuff '("abc" "def" "ghi"))
("abc" "def" "ghi")
_$ (setq uppercase_stuff (mapcar 'strcase lower_case_stuff))

("ABC" "DEF" "GHI")
_$

[andrew_nao]

_$ (setq lower_case_stuff '("abc" "def" "ghi"))
("abc" "def" "ghi")
_$ (setq uppercase_stuff (mapcar 'strcase lower_case_stuff))

("ABC" "DEF" "GHI")
_$

hmmm not working for me

Code: [Select]

(setq oldblock_lst '(("l-89-1") ("l-89-2") ("l-89-3")
                         ("l-89-5") ("tag-l") ("tag-m")
                         ("tag-s") ("naotag-l") ("naotag-m")
                         ("naotag-s")
                    )
)


Command: (setq oldblock_lst (mapcar 'strcase oldblock_lst))
; error: bad argument type: stringp ("l-89-1")

[dgorsman]

Watch your brackets.  Putting brackets around something denotes a function call, or creating a quoted list.  Of course, a string is neither, so it throws a fit.  To create a list of strings, just provide the strings to the list.

[andrew_nao]

Watch your brackets.  Putting brackets around something denotes a function call, or creating a quoted list.  Of course, a string is neither, so it throws a fit.  To create a list of strings, just provide the strings to the list.

i can get my code to work unless the list (oldblock_lst) is in brackets
im trying all different things to change this to get it to work but nothing is working so far
do you have any suggestions?

[uncoolperson]

(setq uppercase_stuff (mapcar '(lambda (x) (mapcar 'strcase x)) lower_case_stuff))

there's better ways, but this was fun

[CAB]

Not to muddy the waters but here is some untested code to consider.  (thrown together, my apologies but short on time today)

Code: [Select]

(defun ub (/ blocknames clayout ename foundnameflag i inspt jobno lay newblknm oldblk
           oldblknm rot ss vlaobj xscale yscale zscale newobj)
  (setvar "cmdecho" 0)
  (setq jobno (substr (vl-filename-base
                        (vl-filename-directory (getvar "Dwgprefix"))) 1 6))
  (setq blocknames
         '(("l-89-1" "naotag-l")        ; <old name>  <new name>
           ("l-89-2" "naotag-l")
           ("l-89-3" "naotag-m")
           ("l-89-5" "naotag-s")
           ("tag-l" "naotag-l")
           ("tag-m" "naotag-m")
           ("tag-s" "naotag-s")
           ("naotag-l" "naotag-l")
           ("naotag-m" "naotag-m")
           ("naotag-s" "naotag-s")
          )
  )

  (foreach blk blocknames
    (setq oldblknm (car blk)
          newblknm (cadr blk)
          foundnameflag nil
    )

    (if (and (tblsearch "block" oldblknm) ; look for old name
             (setq ss (ssget "X" (list (cons 2 oldblknm) (cons 410 clayout))))
        )
      (if (or foundnameflag
              (tblsearch 'block newblknm)
              (setq newblknm (findfile (strcat newblknm ".dwg")))
          )
        (progn                          ; found existing inserts in drawing
          ;; process the selection set of inserts
          (setq i -1)
          (while (setq ename (ssname ss (setq i (1+ i))))
            (setq vlaobj (vlax-ename->vla-object ename)
                  inspt  (vlax-get vlaobj 'insertionpoint)
                  rot    (vla-get-rotation vlaobj)
                  lay    (vla-get-layer vlaobj)
                  xscale (vla-get-xscalefactor vlaobj)
                  yscale (vla-get-yscalefactor vlaobj)
                  zscale (vla-get-zscalefactor vlaobj)
            )
            (command "-insert" newblknm inspt xscale "" rot jobno) ; insert new block
            (setq NewObj (vlax-ename->vla-object (entlast)))
            (vla-put-layer newobj lay)
            (setq foundnameflag t)
          )
          (command "_erase" ss "")
          (command "_purge" "_B" oldblk "n")
        )                               ; progn
      )                               ; endif
      ;;  else
      (prompt (strcat "\nERROR - Block Not Found. -> " (cadr blk) " <-"))
    )                               ; endif
  ) ; end foreach
  (setvar "cmdecho" 1)
  (princ)
)

[dgorsman]

Watch your brackets.  Putting brackets around something denotes a function call, or creating a quoted list.  Of course, a string is neither, so it throws a fit.  To create a list of strings, just provide the strings to the list.

i can get my code to work unless the list (oldblock_lst) is in brackets
im trying all different things to change this to get it to work but nothing is working so far
do you have any suggestions?

Playing out a little more line to make the fishing easier.   

Read up on string and list-of-string type data, so you can understand the differences between them and how they look in LISP.  Put together some simple foo-examples to work with.  That will help with locating the brackets in the correct quatities and locations.