Default setting aerial survey

January 10, 2022

Hi guys,

After a long time . . .

Could anyone help me out to figure out

(setq blkLyrScaList '(("BLOCK1" "LAYER1" "250" "250" "1") ("BLOCK2" "LAYER2" "500" ""500 "1") ("BLOCK3" "LAYER3" "150" ""150 "1") ("BLOCK4" "LAYER4" "100" ""100 "1")))

Exam:
All BLOCK1 should move to layer1 then
setpropertyvalue X to 250
setpropertyvalue Y to 250
setpropertyvalue Z to 1

January 10, 2022

This is just a list where is the rest of the lisp?

January 10, 2022

Have to generate a lisp to work with my "list", the list I have taken from another lisp, but that will do something else.

January 10, 2022

This will ~~get you started~~. do what you want. Scales from the insertion point of the block.

(defun c:BLKSCALE (/ blklst SS obj ed)
  (setq blklst '(("BLOCK1" "LAYER1" 250 250) ("BLOCK2" "LAYER2" 500 500) 
                 ("BLOCK3" "LAYER3" 150 150) ("BLOCK4" "LAYER4" 100 100))
  )
  (foreach ent blklst
    (setq blkname (car ent) ent (cdr ent))
    (if (setq SS (ssget "_X" (list '(0 . "INSERT") (cons 2 blkname))))
      (foreach blk (mapcar 'cadr (ssnamex SS))
        (setq ed (entget blk)
              ed (subst (cons 8 (car ent)) (assoc 8 ed) ed)
              ed (subst (cons 41 (cadr ent))(assoc 41 ed) ed)
              ed (subst (cons 42 (caddr ent)) (assoc 42 ed) ed)
              ed (subst (cons 43 1) (assoc 43 ed) ed)  ;This was always one so removed from list
        ) 
        (entmod ed) 
      )
    )
  )
  (princ)
)

Edited January 10, 2022 by mhupp

January 10, 2022

Just an extra to what Mhupp provided ignoring the number v's string you must check more carefully for typo's

("BLOCK2" "LAYER2" "500" ""500 "1") 2 mistakes a double "" and a missing "

January 11, 2022

11 hours ago, mhupp said:

This will ~~get you started~~. do what you want. Scales from the insertion point of the block.

(defun c:BLKSCALE (/ blklst SS obj ed)
  (setq blklst '(("BLOCK1" "LAYER1" 250 250) ("BLOCK2" "LAYER2" 500 500) 
                 ("BLOCK3" "LAYER3" 150 150) ("BLOCK4" "LAYER4" 100 100))
  )
  (foreach ent blklst
    (setq blkname (car ent) ent (cdr ent))
    (if (setq SS (ssget "_X" (list '(0 . "INSERT") (cons 2 blkname))))
      (foreach blk (mapcar 'cadr (ssnamex SS))
        (setq ed (entget blk)
              ed (subst (cons 8 (car ent)) (assoc 8 ed) ed)
              ed (subst (cons 41 (cadr ent))(assoc 41 ed) ed)
              ed (subst (cons 42 (caddr ent)) (assoc 42 ed) ed)
              ed (subst (cons 43 1) (assoc 43 ed) ed)  ;This was always one so removed from list
        ) 
        (entmod ed) 
      )
    )
  )
  (princ)
)

That was amazing, thank you so much

Could you please slightly modify to shot layer color as i added

(defun c:BLKSCALE (/ blklst SS obj ed)
  (setq blklst '(("BLOCK1" "LAYER1" 100 100 10) ("BLOCK2" "LAYER2" 250 250 30) ("BLOCK3" "LAYER3" 150 150 210) ("BLOCK4" "LAYER4" 100 100 170)))
  (foreach ent blklst
    (setq blkname (car ent) ent (cdr ent))
    (if (setq SS (ssget "_X" (list '(0 . "INSERT") (cons 2 blkname))))
      (foreach blk (mapcar 'cadr (ssnamex SS))
        (setq ed (entget blk)
              ed (subst (cons 8 (car ent)) (assoc 8 ed) ed)
              ed (subst (cons 41 (cadr ent)) (assoc 41 ed) ed)
              ed (subst (cons 42 (caddr ent)) (assoc 42 ed) ed)
              ed (subst (cons 43 1) (assoc 43 ed) ed)) ;This was always one so removed from list
        (entmod ed) 
      )
    )
  ) (princ))


        (setq  ed (subst (cons 62 (xxxxxx ent)) (assoc 62 ed) ed))

(("BLOCK1" "LAYER1" 100 100 10) ("BLOCK2" "LAYER2" 250 250 30) ("BLOCK3" "LAYER3" 150 150 210) ("BLOCK4" "LAYER4" 100 100 170))

Edited January 11, 2022 by Gentile Romano

January 11, 2022

Its not that simple to change the color of a Block. You have to change each sub entity I suggest changing them to bylayer (256) then setting the layer color to what you want. That way it changes automatically.

updated this lisp to use acad_colordlg

;****************************************************************************************
;   UPDATE BLOCK COLOR (updblkcl.lsp) 
;   PRE-INSERTED BLOCK DEFINITION CLEAN-UP UTILITY
; 
;   This routine is especially usefull to redefine pre-inserted blocks whose 
;   entity colors need to be changed to BYLAYER. 
; 
;   This routine allows the user to update the color of all entities within
;   a block to a single color (exam: color=BYLAYER) without the user 
;   having to explode the symbol.  By default the layer name of 
;   all entities are NOT changed. The routine changes the original 
;   definition of the block within the current drawing. 
; 
;   To use this routine the user is asked to specify a single 
;   color to place all entities of a selected block(s). 
; 
;   The user is next prompted to select one or more blocks to update. The routine 
;   then redefines all entities of the block to the color specified. 
; 
;   When the user regenerates the drawing she/he will find that all 
;   occurances of the block have been redefined.  This is because the 
;   original definition of the block is changed!!! 
; 
;       by CAREN LINDSEY, July 1996 
;****************************************************************************************
; 
;INTERNAL ERROR HANDLER

(defun err-ubc (s)       ; If an error (such as CTRL-C) occurs
  (if (/= s "Function cancelled")
    (princ (strcat "\nError: " s))
  )
  (setq *error* olderr)  ; Restore old *error* handler
  (princ)
)  ;err-ubc
(DEFUN C:BBL (/ BLK CBL CBL2 C ACL ALY NLY NCL)
  (vl-load-com)
  (setq olderr *error* *error* err-ubc)
  (setq C (acad_colordlg 0))
  (prompt "\nPick blocks to update. ")
  (setq SS (ssget '((0 . "INSERT"))))
  (setq K 0)
  (while (< K (sslength SS))
    (setq CBL (tblsearch "BLOCK" (cdr (assoc 2 (entget (setq BLK (ssname SS K)))))))
    (setq CBL2 (cdr (assoc -2 CBL)))
    (while (boundp 'CBL2)
      (setq EE (entget CBL2))
      (setq NCL (cons 62 C))
      (setq ACL (assoc 62 EE))
      (if (= ACL nil)
        (setq NEWE (append EE (list NCL)))
        (setq NEWE (subst NCL ACL EE))
      )  ;if
      (entmod NEWE)
      (setq CBL2 (entnext CBL2))
    )         ;end while
    (entupd BLK)
    (setq K (1+ K))
  )  ;end while
  (setq *error* olderr)
  (vla-Regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports)
  (princ)
)

Edited January 12, 2022 by mhupp

January 12, 2022

(("BLOCK1" "LAYER1" 100 100 10) ("BLOCK2" "LAYER2" 250 250 30) ("BLOCK3" "LAYER3" 150 150 210) ("BLOCK4" "LAYER4" 100 100 170))

The layer1, Layer2 & Layer3 was creating newly, that color wants to change.

January 12, 2022

If layer isn't there before command is run it will be created but with default settings. This will then change the layer to the correct color from your list. this is prob the best option with all block entity's color to byblock. the second lisp takes part of the updblkcl.lsp and changes entity's color in the block.

;entmod layer change color
(defun c:BLKSCALE (/ blklst lst blkname SS ent blk C CBL)
  (vl-load-com)
  (setq blklst '(( "BLOCK1" "LAYER1" 250 250 10) ( "BLOCK2" "LAYER2" 500 500 30)
                   ( "BLOCK3" "LAYER3" 150 150 210) ( "BLOCK4" "LAYER4" 100 100 170)
                )
  )
  (foreach lst blklst
    (setq blkname (car lst) lst (cdr lst))
    (if (setq SS (ssget "_X" (list '(0 . "INSERT") (cons 2 blkname))))
      (progn
        (foreach blk (mapcar 'cadr (ssnamex ss))
          (entmod
            (append (entget blk) (mapcar 'cons '(8 41 42 43) (list (car lst) (cadr lst) (caddr lst) 1)))
          )
        )
        (setq lay (entget (tblobjname "LAYER" (car lst))))
        (entmod (subst (cons 62 (last lst)) (assoc 62 lay) lay))
      )
    )
  )
  (vla-Regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports)
  (princ)
)

;endmod block change color
(defun c:BLKSCALE (/ blklst lst blkname SS ent blk C CBL)
  (vl-load-com)
  (setq blklst '(( "BLOCK1" "LAYER1" 250 250 10) ( "BLOCK2" "LAYER2" 500 500 30)
                   ( "BLOCK3" "LAYER3" 150 150 210) ( "BLOCK4" "LAYER4" 100 100 170)
                )
  )
  (foreach lst blklst
    (setq blkname (car lst) lst (cdr lst))
    (if (setq SS (ssget "_X" (list '(0 . "INSERT") (cons 2 blkname))))
      (progn
        (foreach blk (mapcar 'cadr (ssnamex ss))
          (entmod
            (append (entget blk) (mapcar 'cons '(8 41 42 43) (list (car lst) (cadr lst) (caddr lst) 1)))
          )
        )
        (setq C (last lst))
        (setq CBL (tblsearch "BLOCK" (cdr (assoc 2 (entget blk))))))
        (setq CBL2 (cdr (assoc -2 CBL)))
        (while (boundp 'CBL2)
          (setq EE (entget CBL2))
          (setq NCL (cons 62 C))
          (setq ACL (assoc 62 EE))
          (if (= ACL nil)
            (setq NEWE (append EE (list NCL)))
            (setq NEWE (subst NCL ACL EE))
          )         ;if
          (entmod NEWE)
          (setq CBL2 (entnext CBL2))
        )           ;end while
      )
    )
  )
  (vla-Regen (vla-get-activedocument (vlax-get-acad-object)) acAllViewports)
  (princ)
)

Edited January 12, 2022 by mhupp
update to ronjonp code

January 12, 2022

Differences between ByLayer vs ByBlock: https://www.cad-notes.com/layer-0-bylayer-and-byblock/

I generally set all entity properties in blocks to ByBlock on layer 0 so display insertions of those blocks can be controlled by drawing properties.

January 12, 2022

6 hours ago, tombu said:

Differences between ByLayer vs ByBlock: https://www.cad-notes.com/layer-0-bylayer-and-byblock/

I generally set all entity properties in blocks to ByBlock on layer 0 so display insertions of those blocks can be controlled by drawing properties.

Same here.

January 12, 2022

@mhupp FWIW

;; This
(foreach blk (mapcar 'cadr (ssnamex ss))
  (setq	ed (entget blk)
	ed (subst (cons 8 (car ent)) (assoc 8 ed) ed)
	ed (subst (cons 41 (cadr ent)) (assoc 41 ed) ed)
	ed (subst (cons 42 (caddr ent)) (assoc 42 ed) ed)
	ed (subst (cons 43 1) (assoc 43 ed) ed)
  )
  (entmod ed)
)
;; Can be written like this
(foreach blk (mapcar 'cadr (ssnamex ss))
  (entmod (append (entget blk)
		  (list (cons 8 (car ent)) (cons 41 (cadr ent)) (cons 42 (caddr ent)) (cons 43 1))
	  )
  )
)
;; Or this too :)
(foreach blk (mapcar 'cadr (ssnamex ss))
  (entmod
    (append (entget blk) (mapcar 'cons '(8 41 42 43) (list (car ent) (cadr ent) (caddr ent) 1)))
  )
)

Assuming I didn't fat finger something

January 12, 2022

38 minutes ago, ronjonp said:

@mhupp FWIW

Assuming I didn't fat finger something

as always thank you.

January 12, 2022

4 minutes ago, mhupp said:

as always thank you.

Sign In

Default setting aerial survey

Recommended Posts

Gentile Romano

mhupp

Gentile Romano

mhupp

BIGAL

Gentile Romano

mhupp

Gentile Romano

mhupp

tombu

ronjonp

ronjonp

mhupp

ronjonp

Join the conversation

Tutorials

Forums

Activity