TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: dussla on September 03, 2010, 11:07:42 PM
-
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
-
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
-
See if this is any quicker:
(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.
-
thank you , thank you for good anwser
-
thank you , thank you for good anwser
You're welcome Dussla, if you have any questions about the code, just ask.