Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Dynamic block replace routine. Works but need help. 1

Status
Not open for further replies.

vbcad

Technical User
Jul 12, 2002
159
US
I have posted some code below. It works to do what I need it to do, however I would like to automate it further and this is where I am stuck. The code replaces a block by name and then changes the view propertie of the dynamic block. The problem I am having is that I need to select previous thru keyboard entry to change the view of the blocks. I would like to have this be automatic as I have several blocks to replace wtih the smae named block and change views seperately. Thanks in advance.
Code:
(defun c:drp (/ ENT1 BL1 NWNM OLD ODNM)	;THIS PROGRAM REPLACES SELECTED DUPLEX RECEPTACLE BLOCKS WITH THE PROPER RECEPTACLE BLOCK IN AN ELECTRICAL DRAWING
  (initerr2)
  (command "-insert" "rec.dwg" "0,0" "" "" "")
  (command "erase" "l" "")
  (prompt "Select duplex receptacle blocks to replace: ")
  (setq	ENT1
	 (ssget
	   (list
	     (cons 0 "INSERT")
	     (cons
	       2
	       "DR"
	     )
	   )
	 )
  )
  (setq N (sslength ENT1))
  (setq I 0)
  (repeat N
    (setq BL1 (entget (ssname ENT1 I))
	  NM  (cdr (assoc 2 BL1))
    )
    (setq NWNM (cons 2 (strcat "REC")))
    (setq OLD (assoc 2 BL1))
    (entmod (subst NWNM OLD BL1))
    (setq I (1+ I))
  )
  (c:chp)
  (prin1)
  (reset2)
  (command "-purge" "b" "*" "n")
)
;;;*==========================================================
(defun initerr2	()
  (setq oldortho (getvar "orthomode"))
  (setq oldlayer (getvar "clayer"))
  (setq oldsnap (getvar "osmode"))
  (setq oldSTYLE (getvar "TEXTSTYLE"))
  (setq echo (getvar "cmdecho"))
  (setq temperr *error*)
  (setq *error* trap2)
  (princ)
)
;;;*===========================================================
(defun trap2 (errmsg)
  (command nil nil nil)
  (if (not
	(member	errmsg
		'("console break" "Function Cancelled")
	)
      )
    (princ (strcat "\nError: " errmsg))
  )
  (setvar "orthomode" oldortho)
  (setvar "clayer" oldlayer)
  (setvar "osmode" oldsnap)
  (setvar "textstyle" oldstyle)
  (setvar "cmdecho" echo)
  (command "-purge" "b" "*" "n")
  (alert "No Replacable Blocks Found!")
  (terpri)
  (setq *error* temperr)
  (princ)
)
;;;*===========================================================
(defun reset2 ()
  (setvar "clayer" oldlayer)
  (setvar "osmode" oldsnap)
  (setvar "textstyle" oldstyle)
  (setvar "cmdecho" echo)
  (command "-purge" "b" "*" "n")
  (princ)
)

;;;*======================================================
(princ)

;----------------------------------------------------------- DynamicProps -----
; Function retrieve or set properties from a dynamic block
; (DynamicProps (car (entsel)) "Visibility" nil) get the visibility states from a dynamic block
; (DynamicProps (car (entsel)) "Visibility" "Construction") set the visibility from a dynamic block
; (DynamicProps (car (entsel)) "" nil) get the properties from a dynamic block
; (DynamicProps (car (entsel)) "Pipe length" 2000.0) set the properties from a dynamic block
(defun DynamicProps (ename propname value / obj prpL cla cll prp)
  (setq obj (if (= (type ename) 'VLA-OBJECT) ename (vlax-ename->vla-object ename)))
  (setq prpL (vlax-invoke obj 'getdynamicblockproperties))
  (setq return
    (if (setq prp (vl-remove-if-not (function (lambda(x)(= (vlax-get-property x 'PropertyName) propname))) prpL))
      (mapcar (function (lambda(v)
        (if (and (/= value nil)(vlax-property-available-p v 'Value)(/= (type value)'LIST))
          (progn (vlax-put-property v 'Value value)(vla-update obj))
        )
        (if (and (vlax-property-available-p v 'AllowedValues) (vlax-get v 'AllowedValues))
          (list (vlax-get v 'Value)(vlax-get v 'AllowedValues))
	  (vlax-get v 'Value)
        )
      )) prp)
      (mapcar (function (lambda(v)(list (vla-get-propertyName v)(vlax-get v 'Value) v))) prpL)
    )
  )
  return
)
;------------------------------------------------ MWE:GetDBlockNames ------------------
; Function for filtering dynamic blocks
; Arguments: 1
;    arglst = list met names
; Syntax: (MWE:GetDBlockNames '("Issue Stamp")) --> (("ISSUE STAMP" "*U833" "*U841") 
;function by James Allen.
;;; Returns all names used for a dynamic block, including
;;; the actual block name and all anonymous instances.
;;;
;;; (setq names (MWE:GetDBlockNames (list bname)))
;;;
;;; bname = Str - Dynamic block name
;;; names = List - List of all inserted blocks whose
;;; EffectiveName = bname
;;;
;;; (setq names (MWE:GetDBlockNames '("TestDBlock")))
;;; ("TestDBlock" "*U4" "*U5" "*U6")
;;;
;;; James Allen - 26Apr07
;;; Malicoat-Winslow Engineers, P.C.
;;;
;;; Thanks to Joe Burke for pointing out code 331
;;; and to Tony Tanzillo for prodding in that direction.
;;;
(defun MWE:GetDBlockNames (arglst / blk edt enm ins name names)
  (mapcar 'set '(name) arglst)
  (setq names (list name) name (strcase name))
  (vl-load-com)
  (vlax-for blk (vla-get-Blocks (vlax-get (vlax-get-Acad-Object) 'ActiveDocument))
    (if (and (setq enm (tblobjname "block" (vla-get-Name blk)))
      (setq edt (entget enm))
      (= (logand (cdr (assoc 70 edt)) 1) 1))
      (if (and (setq edt (entget (vlax-vla-object->ename blk)))
        (setq enm (cdr (assoc 331 edt)))
        (setq ins (vlax-ename->vla-object enm))
        (eq (vla-get-ObjectName ins) "AcDbBlockReference")
        (wcmatch (strcase (vla-get-EffectiveName ins)) name))
        (setq names (cons (vla-get-Name blk) names))
      )
    )
  )
  (reverse names)
) ;end
;------------------------------------------------ BlockNamesFilter ------------------
;; Argument example: ("TestDBlock" "*U4" "*U5" "*U6")
;; Returns: "TestDBlock,`*U4,`*U5,`*U6,"
(defun BlockNamesFilter (strlst)
  (apply 'strcat (mapcar '(lambda (x)
    (if (wcmatch x "`**,`?*")(strcat "`" x ",")(strcat x ","))) strlst)
  )
)
;----------------------------------------------------------- ChangeVisibility -----
;; Argument example: (ChangeVisibility "Issue Stamp" "Review")
;; Returns: number of changed states
(defun ChangeVisibility (BlkName state / names ss ssl tempEnt)
  (setq names (MWE:GetDBlockNames (list BlkName)))
  (prompt (strcat "\nSelect insert Name " BlkName ": "))
  (if (and (setq ss (ssget (list '(0 . "INSERT")(cons 2 (BlockNamesFilter names)))))
    (> (setq ssl (sslength ss)) 0))
    (progn
      (while (setq tempEnt (ssname ss 0))
	(DynamicProps (vlax-ename->vla-object tempEnt) "Visibility" state)
        (ssdel tempEnt ss)
      )
      (princ (strcat "\nChanged "(itoa ssl) " inserts to the visibility <" state ">."))
      ssl
    )
    (princ (strcat "\nInsert " BlkName " not found."))
  )
)
;----------------------------------------------------------- c:Chp -----
(defun c:Chp ()   ;changes visibility to duplex plan receptacle
  (ChangeVisibility "REC" "Duplex Plan")
  (princ)
)


 
Hi vbcad,

Try this:
Code:
(setq    ENT1
     (ssget [b][red]"X"[/red][/b]
       (list
         (cons 0 "INSERT")
         (cons
           2
           "DR"
         )
       )
     )
  )

HTH
Todd
 
OK getting closer. I would like to by pass this line witth the previous selection. Possible problem are in red. This line prompts me for blocks name and it does say "REC:" which is the block name but I have to type P fro previous selection. Trying to get around this so it runs with no entry from the user except to call the command.
Code:
;----------------------------------------------------------- ChangeVisibility -----
;; Argument example: (ChangeVisibility "Issue Stamp" "Review")
;; Returns: number of changed states
(defun ChangeVisibility (BlkName state / names ss ssl tempEnt)
  (setq names (MWE:GetDBlockNames (list BlkName)))
  [red](prompt (strcat "\nSelect insert Name " BlkName ": "))[/red]
  (if (and (setq ss (ssget (list '(0 . "INSERT")(cons 2 (BlockNamesFilter names)))))
    (> (setq ssl (sslength ss)) 0))
    (progn
      (while (setq tempEnt (ssname ss 0))
	(DynamicProps (vlax-ename->vla-object tempEnt) "Visibility" state)
        (ssdel tempEnt ss)
      )
      (princ (strcat "\nChanged "(itoa ssl) " inserts to the visibility <" state ">."))
      ssl
    )
    (princ (strcat "\nInsert " BlkName " not found."))
  )
)
 
Hi vbcad,

Hmmm...

I'm not sure I understand, so here's interpretation #1:

You're going to have to know the name going in. Either that, or you build a list of block names found in the drawing, and then take a best guess at what the name is, based on the list the routine found.

Otherwise, here's interpretation #2:

Just dump the prompt, you're not setting anything to a variable based on that, so your new ssget would be:

Code:
(if (and (setq ss (ssget [red][b]"X"[/b][/red] (list '(0 . "INSERT")(cons 2 (BlockNamesFilter names)))))

HTH
Todd



 
Your second interpretation was correct to a certain extent. I ahve several blocks that i am replacing with the REC block in a different view. I ran the code with out the prompt and it changed all of the REC blocks to the last view routine I run. I it possible in the prompt portion to automatically select the previous selection set?
 
Hi vbcad,

Not through the prompt command, but through the ssget command:
Code:
(if (and (setq ss (ssget [b][red]"P"[/red][/b] (list '(0 . "INSERT")(cons 2 (BlockNamesFilter names)))))

HTH
Todd
 
Works awesome! you get another star
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top