Jump to content

block setbyblock lineweight layer 0


jim78b

Recommended Posts

is possible to have a lisp that put all entities that are on layer 0 lineweight to byblock?

i have this code but put even other layers on setbyblock lineweight

 

(vl-load-com)

(defun c:bf  (/ col cnt lop sel)
;;;--------------------------------------------------------------------------------------------------------------------- 
; Dynamic blocks don't update and I dont know why. Vla-update doesnt work. Vla-resetBlock works but all dynamic parametres are lost. 
;;; subroutines
  ;; remove duplicated items in list
  (defun LM:unique  (l) ; by Lee Mac
    (if l
      (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))))
  ;; set "by block" to all entities in block definition
  (defun BB:setByBlock  (nam / blc blk)
    (setq blc (vla-get-blocks (vla-get-activedocument
(vlax-get-acad-object))))
    (setq blk (vla-item blc nam))
    (vlax-for x  blk
;;;     (vla-put-layer x "0")
;;;     (vla-put-color x acByBlock)
;;;     (vla-put-linetype x "ByLayer")
;;;    (vla-put-linetypescale x 1.0)
      (vla-put-lineweight x acLnWtByBlock)
;;;      (vla-put-entityTransparency x "ByBlock:")
;;;      (vla-put-material x "ByBlock")
      (if (eq (vla-get-objectName x) "AcDbBlockReference")
        (BB:setByBlock (vla-get-effectiveName x))))
      )
;;;---------------------------------------------------------------------------------------------------------------------
;;; main
  (setq lop t)
  (while lop
    (princ "\nSelect blocks: ")
    (if (setq sel (ssget '((0 . "INSERT"))))
      (progn (setq cnt 0)
             (setq col nil)
             (repeat (sslength sel)
               (setq obx (vlax-ename->vla-object (ssname sel
cnt)))
               (setq col (cons (vla-get-effectiveName obx) col))
             (setq cnt (1+ cnt)))
      (setq col (LM:unique col))
      (foreach x col (BB:setByBlock x))
      (setq lop nil))
    (princ "\nNo selection")))
(vla-regen (vla-get-ActiveDocument (vlax-get-acad-object))
acActiveViewport)
(princ))

 

Link to comment
Share on other sites

4 hours ago, jim78b said:

is possible to have a lisp that put all entities that are on layer 0 lineweight to byblock?

i have this code but put even other layers on setbyblock lineweight

 


(vl-load-com)

(defun c:bf  (/ col cnt lop sel)
;;;--------------------------------------------------------------------------------------------------------------------- 
; Dynamic blocks don't update and I dont know why. Vla-update doesnt work. Vla-resetBlock works but all dynamic parametres are lost. 
;;; subroutines
  ;; remove duplicated items in list
  (defun LM:unique  (l) ; by Lee Mac
    (if l
      (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))))
  ;; set "by block" to all entities in block definition
  (defun BB:setByBlock  (nam / blc blk)
    (setq blc (vla-get-blocks (vla-get-activedocument
(vlax-get-acad-object))))
    (setq blk (vla-item blc nam))
    (vlax-for x  blk
;;;     (vla-put-layer x "0")
;;;     (vla-put-color x acByBlock)
;;;     (vla-put-linetype x "ByLayer")
;;;    (vla-put-linetypescale x 1.0)
      (vla-put-lineweight x acLnWtByBlock)
;;;      (vla-put-entityTransparency x "ByBlock:")
;;;      (vla-put-material x "ByBlock")
      (if (eq (vla-get-objectName x) "AcDbBlockReference")
        (BB:setByBlock (vla-get-effectiveName x))))
      )
;;;---------------------------------------------------------------------------------------------------------------------
;;; main
  (setq lop t)
  (while lop
    (princ "\nSelect blocks: ")
    (if (setq sel (ssget '((0 . "INSERT"))))
      (progn (setq cnt 0)
             (setq col nil)
             (repeat (sslength sel)
               (setq obx (vlax-ename->vla-object (ssname sel
cnt)))
               (setq col (cons (vla-get-effectiveName obx) col))
             (setq cnt (1+ cnt)))
      (setq col (LM:unique col))
      (foreach x col (BB:setByBlock x))
      (setq lop nil))
    (princ "\nNo selection")))
(vla-regen (vla-get-ActiveDocument (vlax-get-acad-object))
acActiveViewport)
(princ))

 

 

Are you trying to set all entities in all blocks to layer 0, color byblock,  linetype bylayer and lineweight byblock?

 

It will not work with dynamic blocks because you are finding the effective name of the block, not the name of the block.

 

If the answer to the first question is yes then you need to iterate all the blocks in the block table (omitting layouts and xrefs). This should take care of the dynamic blocks.

 

 

Link to comment
Share on other sites

OK try one of these.

 

The first is your original code corrected to to only set the lineweight of block entities that are on layer "0". I have moved the two sub functions outside the main function. This should also now do dynamic blocks and alters both the effectivename definition and the anonymous definition. This will only process the blocks in the selection set.

 

The second (c:lwbb) iterates the block definition table and requires no selection set. Again it will set the lineweight of block entities on layer "0", but it will process ALL block definitions except XREFS, LAYOUTS and DIMS (as far as possible). The DIMS part needs a bit of explaining as this assumes that your drawing units are not set to "Unitless" and the block defnitions  are not unitless. If this is the case any unitless blocks will not be processed.

 

Any problems let me know.

 

(defun LM:unique  (l) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))))

;; set "by block" to all entities in block definition
(defun BB:setByBlock  (nam / blc blk)
  (setq blc (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
  (setq blk (vla-item blc nam))
  (vlax-for x  blk (if (= "0" (vlax-get-property x 'layer)) (vlax-put-property x 'lineweight acLnWtByBlock)))
)

(vl-load-com)

(defun c:bf ( / c_doc sel cnt obj col)

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object)))
  (princ "\nSelect blocks : ")
  (setq sel (ssget '((0 . "INSERT"))))
  (cond (sel
          (repeat (setq cnt (sslength sel))
            (setq obj (vlax-ename->vla-object (ssname sel (setq cnt (1- cnt)))))
            (cond ( (= :vlax-true (vlax-get-property obj 'isdynamicblock))
                    (setq col (cons (vla-get-effectivename obj) col)
                          col (cons (vla-get-name obj) col)
                    )
                  )
                  (t  (setq col (cons (vla-get-effectiveName obx) col)))
            );end_cond
          );end_repeat
          (setq col (LM:unique col))
          (foreach x col (BB:setByBlock x))
        )
        ( (princ "\nNothing Selected"))
  );end_cond
  (vla-regen c_doc acActiveViewport)
  (princ)
)

(defun c:lwbb ( / c_doc c_blks)

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_blks (vla-get-blocks c_doc)
  );end_setq
  
  (vlax-for blk c_blks
    (cond ( (and  (= :vlax-false (vlax-get-property blk 'isxref))   ;NOT an XREF
                  (= :vlax-false (vlax-get-property blk 'islayout)) ;NOT A LAYOUT
                  (/= 0 (vlax-get-property blk 'units))             ;NOT A DIMENSION
            );end_and
            (vlax-for itm blk
              (if (= "0" (vlax-get-property itm 'layer)) (vlax-put-property itm 'lineweight acLnWtByBlock))
            );end_for
          )
    );end_cond
  );end_for
  (vla-regen c_doc acAllViewports)
  (princ)
);end_defun

 

Edited by dlanorh
code update
Link to comment
Share on other sites

7 hours ago, jim78b said:

what must i use lm or bf? between codes give me bad argument type

 

type bf for your corrected original code

 

type lwbb for the second code. This has been updated above as there was a hyphen missing which caused the error.

Link to comment
Share on other sites

2 hours ago, jim78b said:

I NEED THE SELECTION SET BUT GIVE ME ERROR WHY?

 

I only copy BF but don't do anything sorry

 

For bf you need to copy bf lm:unique and bb:setbyblock then type bf to run it. Copy all of the below or download the attached.

 

(defun LM:unique  (l) (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l))))))

;; set "by block" to all entities in block definition
(defun BB:setByBlock  (nam / blc blk)
  (setq blc (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))))
  (setq blk (vla-item blc nam))
  (vlax-for x  blk (if (= "0" (vlax-get-property x 'layer)) (vlax-put-property x 'lineweight acLnWtByBlock)))
)

(vl-load-com)

(defun c:bf ( / c_doc sel cnt obj col)

  (setq c_doc (vla-get-activedocument (vlax-get-acad-object)))
  (princ "\nSelect blocks : ")
  (setq sel (ssget '((0 . "INSERT"))))
  (cond (sel
          (repeat (setq cnt (sslength sel))
            (setq obj (vlax-ename->vla-object (ssname sel (setq cnt (1- cnt)))))
            (cond ( (= :vlax-true (vlax-get-property obj 'isdynamicblock))
                    (setq col (cons (vla-get-effectivename obj) col)
                          col (cons (vla-get-name obj) col)
                    )
                  )
                  (t  (setq col (cons (vla-get-effectiveName obx) col)))
            );end_cond
          );end_repeat
          (setq col (LM:unique col))
          (foreach x col (BB:setByBlock x))
        )
        ( (princ "\nNothing Selected"))
  );end_cond
  (vla-regen c_doc acActiveViewport)
  (princ)
)

 

bf.lsp

  • Like 1
Link to comment
Share on other sites

1 hour ago, dlanorh said:

Missed that it was in an if statement. Attached amended, minimally tested and working on my system.

bf.lsp 1.28 kB · 1 download

don' t work sorry gain i tried to create a block with 2 lines on layer 0 color bylayer and then a center line on layer ex:axis...

Edited by jim78b
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...