Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 02/18/2022 in all areas

  1. http://www.lee-mac.com/steal.html none tech way. save a copy of your updatemaster.dwg in the same folder as the drawing you want updated. delete everything out of updatedmaster but leave the block definitions. then go into your old drawing and cut all and paste it into the updatemaster.dwg. as long as the blocks have the same name & base point you should be good. then use the steal command to move over everything else.
    2 points
  2. ;; QQSE - QSE in Command Line (defun c:QQSE ( / *error* old_osmode startrange endrange p2 p4 ss ssl ssindex typelist typestacklist ssl ent entname type typestacklist lst result item typeuniquelist tull tulindex tulstack tullist restxt tula tulb userinput1 typeselected ss2 ss2l ss2index colorstacklist layerstacklist ent2 ent2color ent2layer csll lsll cslindex lslindex cslstack lslstack clist llist csla cslb lsla lslb ctlistl ctindex csltxt ltlistl ltindex lsltxt secondfilteranswer ss3 e c ss3l ) (setvar 'cmdecho 0) (setq old_osmode (getvar 'osmode)) (setvar 'osmode 0) (LM:startundo (LM:acdoc)) ;error control (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\n Error: " msg)) ) (setvar 'osmode old_osmode) (setvar 'cmdecho 1) (redraw) (princ) ) (if (and (setq startrange (getpoint "\n Set Range for Quick Selection - Start Point ")) (setq endrange (getcorner startrange "\n Set Range to Quick Selection - End Point ")) ) (progn (setq p2 (list (car endrange) (cadr startrange)) p4 (list (car startrange) (cadr endrange)) ) (grvecs (list -1 startrange p2 p2 endrange endrange p4 p4 startrange)) ) ) (redraw) (princ) (setq ss (ssget "c" startrange endrange)) (sssetfirst nil ss) (setq ssl (sslength ss)) (setq ssindex 0) (setq typelist nil) (setq typestacklist nil) (repeat ssl (setq ent (entget (ssname ss ssindex))) (setq entname (cdr (assoc -1 ent))) (setq type (cdr (assoc 0 ent))) (setq typestacklist (cons type typestacklist)) (setq ssindex (+ ssindex 1)) ) (defun CountItems ( Lst / Item Result ) (foreach x Lst (setq Result (if (setq Item (assoc x Result)) (subst (cons x (1+ (cdr Item))) Item Result) (cons (cons x 1) Result) ) ) ) (reverse Result) ) (setq typeuniquelist (CountItems typestacklist)) (setq tull (length typeuniquelist)) (setq tulindex 0) (setq tulstack (list (list 0 "SELECT_ALL" 0))) (setq tullist nil) (setq restxt "\n Selection No. <0> SELECT ALL") (repeat tull (setq tula (car (nth tulindex typeuniquelist))) (setq tulb (cdr (nth tulindex typeuniquelist))) (setq tullist (list (+ tulindex 1) tula tulb)) (setq restxt (strcat restxt "\n Selection No. <" (vl-princ-to-string (+ tulindex 1)) "> " (vl-princ-to-string tula) " = " (vl-princ-to-string tulb) " ea ")) (setq tulstack (cons tullist tulstack)) (setq tulindex (+ tulindex 1)) ) ;(setq tulstack (cons (list 99 "DUMMY" 0) tulstack)) (setq tulstack (vl-sort tulstack '(lambda (x y) (< (car x)(car y))))) ;(princ tulstack) (princ restxt) (defun userinputter ( / userinput1 ) (initget 5) (setq userinput (getint "\n Input Number to Select : ")) (if (> userinput tulindex) (progn (princ "\n wrong number ") (princ restxt) (userinputter) ) ) ) (userinputter) ;(princ tulstack) (setq typeselected (cadr (nth userinput tulstack))) (princ "\n ") (princ typeselected) (princ " is selected.") (if (= typeselected "SELECT_ALL") (setq ss2 (ssget "c" startrange endrange)) (setq ss2 (ssget "c" startrange endrange (list (cons 0 typeselected)) )) ) (sssetfirst nil ss2) ;(princ ss) (setq ss2l (sslength ss2)) (setq ss2index 0) (setq colorstacklist nil) (setq layerstacklist nil) (repeat ss2l (setq ent2 (entget (ssname ss2 ss2index))) (setq ent2color (cdr (assoc 62 ent2))) (setq ent2layer (cdr (assoc 8 ent2))) (setq colorstacklist (cons ent2color colorstacklist)) (setq layerstacklist (cons ent2layer layerstacklist)) (setq ss2index (+ ss2index 1)) ) (setq colorstacklist (CountItems colorstacklist)) (setq layerstacklist (CountItems layerstacklist)) ;(princ colorstacklist) (setq csll (length colorstacklist)) (setq lsll (length layerstacklist)) (setq cslindex 0) (setq lslindex 0) (setq cslstack nil) (setq lslstack nil) (setq clist nil) (setq llist nil) (repeat csll (setq csla (car (nth cslindex colorstacklist))) (setq cslb (cdr (nth cslindex colorstacklist))) (setq clist (list csla cslb)) (setq cslstack (cons clist cslstack)) (setq cslindex (+ cslindex 1)) ) (repeat lsll (setq lsla (car (nth lslindex layerstacklist))) (setq lslb (cdr (nth lslindex layerstacklist))) (setq llist (list lsla lslb)) (setq lslstack (cons llist lslstack)) (setq lslindex (+ lslindex 1)) ) (setq cslstack (vl-sort cslstack '(lambda (x y) (< (car x)(car y))))) (setq lslstack (vl-sort lslstack '(lambda (x y) (< (car x)(car y))))) (setq ctlistl (length cslstack)) (setq ctindex 0) (setq csltxt " ") (repeat ctlistl (setq csltxt (strcat csltxt "\n Color Code < " (vl-princ-to-string (car (nth ctindex cslstack))) " > = " (vl-princ-to-string (cadr (nth ctindex cslstack))) " ea ")) (setq ctindex (+ ctindex 1)) ) (setq ltlistl (length lslstack)) (setq ltindex 0) (setq lsltxt " ") (repeat ltlistl (setq lsltxt (strcat lsltxt "\n Layer Name < " (vl-princ-to-string (car (nth ltindex lslstack))) " > = " (vl-princ-to-string (cadr (nth ltindex lslstack))) " ea ")) (setq ltindex (+ ltindex 1)) ) (initget 1 "A C L T") (setq secondfilteranswer (getkword "\n 2nd Filter - All (A) / By Color (C) / By Layer (L) / By Textcontents (T): ")) (cond ((= secondfilteranswer "A") (setq ss3 (ssget "_p"))) ((= secondfilteranswer "C") (if (setq e (car (entsel (strcat csltxt "\n Select the object which color you want to find (Press SpaceBar for Input color code by manual input)")))) (progn (setq c (cdr (assoc 62 (entget e)))) );progn (progn (initget 1) (setq c (getint "\n Or Input by Manual : ")) ) );if (setq ss3 (ssget "_p" (list (cons 62 c)))) );cond c ((= secondfilteranswer "L") (if (setq e (car (entsel (strcat lsltxt "\n Select the object which Layer you want to find (Press SpaceBar for Layer Name by manual input)")))) (progn (setq c (cdr (assoc 8 (entget e)))) );progn (progn (initget 1) (setq c (getstring t "\n Or Input by Manual : ")) ) );if (setq ss3 (ssget "_p" (list (cons 8 c)))) );cond l ((= secondfilteranswer "T") (if (setq e (car (entsel (strcat "\n Select the object which Values you want to find (Press SpaceBar for Values by manual input)")))) (progn (setq c (cdr (assoc 1 (entget e)))) );progn (progn (initget 1) (setq c (getstring t "\n Or Input by Manual : ")) ) );if (setq ss3 (ssget "_p" (list (cons 1 c)))) );cond l );cond (if (= ss3 nil) (progn (princ "\n There are no objects that satisfy your filter condition.") (sssetfirst nil nil) ) (progn (sssetfirst nil ss3) (setq ss3l (sslength ss3)) (princ (strcat "\n Selection Complete! Result - " (vl-princ-to-string (sslength ss3)) " ea.")) ) ) (LM:endundo (LM:acdoc)) (setvar 'osmode old_osmode) (setvar 'cmdecho 1) (princ) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc_forrf 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc_forrf) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo_forrf doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) I have referred Select by color, find text lisp I'd like to use QSE, but why there's no "-QSE".... so, this is a degraded imitation of QSE can filter Object type, Color, Layer, Text contents only. like this Set Range for Quick Selection - Start Point Set Range to Quick Selection - End Point Selection No. <0> SELECT ALL Selection No. <1> TEXT = 392 ea Selection No. <2> LINE = 196 ea Selection No. <3> LWPOLYLINE = 23 ea Selection No. <4> CIRCLE = 6 ea Selection No. <5> ARC = 5 ea Selection No. <6> MTEXT = 114 ea Input Number to Select : 1 TEXT is selected. 2nd Filter - All (A) / By Color (C) / By Layer (L) / By Textcontents (T): t Select the object which Values you want to find (Press SpaceBar for Values by manual input) Or Input by Manual : 0096 Selection Complete! Result - 4 ea.
    1 point
  3. I was wondering if NFT's (Non-fungible Tokens) might be used. It might not be practical in this application but in theory would it work?
    1 point
  4. You can Start with AFRALISP for learning LISP, VLISP, VBA, etc. as well as the AutoCAD Developers Guide and Tutorials that come with AutoCAD. If I read the question correctly... The OP wants to insert a block that has objects on specific layers with specific colors, the OP would like for all object in the drawing that are on corresponding layers to be the same color. Or maybe they would like to choose the layers for the color as well.
    1 point
×
×
  • Create New...