Topic: block to each layer and select ele 19 above object

[dussla]

hello freind
good day , good luck

still i am lisp beginner  , sorry  my  lazy
can i help you  pls ?

1. i have many blocks in dwg  
    ex)
          block name       per
             apple         350 objects
             bird            200 objects
 
         if i select all block     ,
                1. make  block name layer  
                2.  send  same name block to same name layer

can you understand ?



2. i would like to select   objects   that  object    elevation  is  above   1 mm  

thank you for great help  always

[dussla]

sorry this code is  modified code from intenet  sorry for rude
i made this routine  , but  very slow  can you fix


(vl-load-com) ;Load VLisp extensions
;; Function to change bllocks to a layer by wildcard
(defun Blk2Lay (LName ss / n en eo)
  (if (not (tblobjname "LAYER" LName)) ;Check if layer doesn't exist
    (command "._LAYER" "_Make" LName "") ;Make the layer
  ) ;_ end of if
  (setq n (sslength ss)) ;Initialize counter
  (while (>= (setq n (1- n)) 0) ;Step through all entities in selection set
    (setq en (ssname ss n) ;Get the nth EName
          eo (vlax-ename->vla-object en) ;Get the ActiveX object
    ) ;_ end of setq
    (vla-put-Layer eo LName) ;Change block reference to new layer
  ) ;_ end of while
) ;_ end of defun

;; Command to change blocks to a layer by wildcard
(defun c:Blk2Lay (/ LName BWild ss)
   (setq k 0)

        ;  (setq ss (ssget "_X" (list '(0 . "INSERT") (cons 2 BWild)))) ;And some blocks found
      (setq ss (ssget (list (cons 0 "insert"))))
         ;_ end of and
      (repeat (sslength ss)
            (setq ed (entget (ssname ss k)) )
            (SETQ la (cdr (assoc 2 ed)))
            (setq ss2 (ssget "_X" (list '(0 . "INSERT") (cons 2 la))))
             (Blk2Lay la ss2) ;Perform the change
    
      (setq k (1+ k))
    
     )
 
  (princ)
) ;_ end of defun

[Lee Mac]

See if this is any quicker:

Code: [Select]

(defun c:Blocks->Layers ( / SubstDXFUpdate Layer ApplyFootoSelSet )
  ;; © Lee Mac 2010

  (defun SubstDXFUpdate ( code value elist )
    (if
      (setq elist
        (entmod
          (subst
            (cons code value) (assoc code elist) elist
          )
        )
      )
      (entupd (cdr (assoc -1 elist)))
    )
  )

  (defun Layer ( Name )
    (entmake
      (list
        (cons 0 "LAYER")
        (cons 100 "AcDbSymbolTableRecord")
        (cons 100 "AcDbLayerTableRecord")
        (cons 2 Name)
        (cons 70 0)
      )
    )
  )

  (defun ApplyFooToSelSet ( foo SelSet )
    (
      (lambda ( i / e )
        (if SelSet
          (while (setq e (ssname SelSet (setq i (1+ i))))
            (foo e)
          )
        )
      )
      -1
    )
  )

  (ApplyFooToSelSet
    (lambda ( e / l )
      (or (tblsearch "LAYER" (setq l (cdr (assoc 2 (entget e)))))
          (Layer l)
      )

      (SubstDXFUpdate 8 l (entget e))
    )
    (ssget "_:L" '((0 . "INSERT")))
  )

  (princ)
)
PS> I haven't filtered for elevation.

[dussla]

thank you , thank you for good anwser

[Lee Mac]

thank you , thank you for good anwser

You're welcome Dussla, if you have any questions about the code, just ask.