Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 05/19/2024 in all areas

  1. Here, try this mhupp's mod... ;;----------------------------------------------------------------------------;; ;; PULL BLOCKS NAME TO UPDATE ATTRIBUTE (defun C:ATTBLKNAME () (C:ABN)) (defun C:ABN ( / effectivename ent Name Att ) (defun effectivename ( ent / blk rep ) (if (wcmatch (setq blk (cdr (assoc 2 (entget ent)))) "`**") (if (and (setq rep (cdadr (assoc -3 (entget (cdr (assoc 330 (entget (tblobjname "block" blk) ) ) ) '("AcDbBlockRepBTag") ) ) ) ) (setq rep (handent (cdr (assoc 1005 rep)))) ) (setq blk (cdr (assoc 2 (entget rep)))) ) ) blk ) (while (setq ent (car (entsel "\nSelect Block"))) ;gets an entity name using while will keep repeating if you keep selecting an entity (if (= (cdr (assoc 0 (entget ent))) "INSERT") ;test if its a block (progn (setq Name (effectivename ent)) ; pulls the name (setq Att (vlax-ename->vla-object (car (nentsel "Select Attribute Text to update")))) ; nentsel can get entity names inisde blocks (vla-put-textstring Att Name) ;update entity with name ) (progn ;if entity isn't a block will prompt user (prompt "\nNot a Block Pick again") (c:ABN) ;and start the comman over again. ) ) ) (princ) )
    2 points
  2. You can be lucky owe me a cup of coffee. ; Oct 2022 ; By AlanH makes a legend of used layers and blocks. (defun RemoveDupes (InLst / OutLst CarElm) (while InLst (setq InLst (vl-remove (setq CarElm (car InLst)) (cdr InLst)) OutLst (cons CarElm OutLst) ) ) ) (defun makelegend ( / ss lst lstrem obj pt pt2 ltname x val bname) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setvar 'textstyle "Standard") (setq oldlay (getvar 'clayer)) (setvar 'clayer "0") (setvar 'ctab "Model") (setq ss (ssget "X" (list (cons 410 "Model")))) (setq lst '()) (repeat (setq x (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) (setq lst (cons (list (vla-get-layer obj) (vlax-get obj 'Linetype)) lst)) ) (setq lst (RemoveDupes lst)) (setq lst (vl-sort lst '(lambda (x y) (< (car x) (car y))))) (setq pt (getpoint "\nPick point for line legend ")) (setq pt2 (mapcar '+ pt (list 125.0 0.0 0.0))) (foreach ltname lst (command "line" pt (mapcar '+ pt (list 20.0 0.0 0.0)) "") (command "chprop" (entlast) "" "LA" (car ltname) "LT" (cadr ltname) "S" 0.25 "") (command "text" (mapcar '+ pt (list 25.0 0.0 0.0)) 2.5 0.0 (car ltname)) (setq pt (mapcar '+ pt (list 0.0 10.0 0.0))) ) (setq lst '()) (setq attreq 0) (repeat (setq x (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) (if (= (vla-get-objectname obj) "AcDbBlockReference") (setq lst (cons (vla-get-name obj) lst)) ) ) (setq lst (RemoveDupes lst)) (setq lst (vl-sort lst '(lambda (x y) (< x y)))) (foreach val lst (if (wcmatch val "*U#*" ) (setq lst (vl-remove val lst)) ) ) (foreach bname lst (progn (command "text" (mapcar '+ pt2 (list 25.0 0.0 0.0)) 2.5 0.0 bname) (command "-insert" bname pt2 1 1 0) (setq pt2 (mapcar '+ pt2 (list 0.0 10.0 0.0))) (setq obj (vlax-ename->vla-object (entlast))) (vla-GetBoundingBox obj 'minpoint 'maxpoint) (setq pointmin (vlax-safearray->list minpoint)) (setq pointmax (vlax-safearray->list maxpoint)) (setq ht (- (cadr pointmax)(cadr pointmin))) (setq xscale (/ 5.0 ht)) (vla-put-xscalefactor obj xscale) (vla-put-yScaleFactor obj xscale) ) ) (setvar 'osmode oldsnap) (setvar 'clayer oldlay) (princ) ) (makelegend)
    1 point
  3. Noticed a type-o Steven (cons 78 (list "ANSI C (17.00 x 22.00 INCHES)" "ANSI B (22.00 x 17.00 INCHES)" )) to (cons 78 (list "ANSI C (17.00 x 22.00 INCHES)" "ANSI C (22.00 x 17.00 INCHES)" ))
    1 point
×
×
  • Create New...