Leaderboard

You might have a look at THIS Could adapt that example maybe?

See if this does anything (defun C:foo (/ name) (vl-load-com) (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object)))) (vlax-for blk (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) ;lists all block definitions in the drawing (cond ((wcmatch (setq name (vla-get-name blk)) "*ARCHI*") ;if block name contains this string (vlax-for obj blk ;step though each entity in the block (vla-put-color obj 8) ;and change its coloer to 8 ) ) ((wcmatch name "*MECHD*") (vlax-for obj blk (vla-put-color obj 1) ) ) ((wcmatch name "*MECHW*") (vlax-for obj blk (vla-put-color obj 2) ) ) ) ) (vla-Regen doc acAllViewports) (vla-endundomark doc) (princ) )

Plain dcl does not support background color in buttons, but in saying that a image button can have a background color, I dont think you can change label color either., the image shown dcl was probably done in C/.net or VBA or Opendcl that have more flexibilty.

Hi @Steven P I did some digging and found two problems: 1. in the SPRAYLINE layer there where 2D POLYLINE objects and the lisp only looking for lines. 2. the objects in the SPRAYLINE layer where with color 234, and in the lisp there no layer with that color defenition. when I corrected those two mistakes the lisp run good. that leads me to ask fpr help on those two issues: 1. is it possible to add error handeler that will make the lisp to ignor errors and continue? 2. I tried to add 2D polylines to the selection set this way, but failed: (if (setq ss (ssget "_X" '((0 . "LINE,POLYLINE,LWPOLYLINE") (8 . "MAINLINE_PIPES,ZONE_PIPES,SPRAYLINES")))) Any help will be appreciated!! thanks, aridzv.

Might also ask Bandicam.com how they did this, a little flattery could be enough for them to 'show off' and share their abilities?

You can also get part way in DCL with the image_button tile (see Lee Macs Attribute Colour for an example), however it doesn't have a label - so no text on top. You might be able to do something by placing text in the pop-up so it bleeds on top of the image, or similar to Lee Macs example, a smaller image to the side of the text that changes colour to highlight where you selected. Like Big Al though, there is nothing that will be a normal button with different colour background. I'd probably use an image button and when you select it swap the images for them all EDIT: Are you sharing the LISP / DCL? In which case any images you use will need to be shared and that user will need to copy them into the safe files location, use the same folder structure you use and code into the LISP or modify the file location to suit themselves. An alternative more tedious is to draw the text as vectors in the image (lines, not text) over a coloured background and this can all be contained in a single LISP file. Bit of work but that might give the result you are looking for?

Well done Mhupp as suggested joins to insertion point. Thinking more do a bounding box then compare distance to say the 4 corners the smallest distance is the one to be used, add 4 more mid points would be even better.

That should get all blocks even if they are nested. but if the nested blocks don't have those strings in their name it won't change color. -edit so block123 is nested inside MECHD-Bigblock MECHD-Bigblock └ Block123 everything in layer 1 of MECHD-Bigblock will change to color 1 but everything in the nested Block123 wont change color

Wasn't going that complicated. using the polyline vertex to pick the closet text to keep in some what of an order. rather then jumping all around. You could use grread to display text as your moving it. This is more a proof of concept. anyone else feel free to make changes. (defun C:TxtMov (/ mspace ss ssP cords size base LL UR pt2) (vl-load-com) (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object)))) (setq mspace (vla-get-ModelSpace doc)) (prompt "\nSelect Polyline to Follow") (setq ssP (ssget "_+.:E:S" '((0 . "LWPOLYLINE")))) (setq cords (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname ssP 0))))) (setq size (getreal "\nText Size: ")) (prompt "\nSelect Text") (while (setq ss (ssget '((0 . "TEXT")))) (foreach pt cords (foreach txt (mapcar 'vlax-Ename->Vla-Object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))) (if (and (setq base (vlax-get txt 'InsertionPoint)) (< (distance pt base) 0.05)) (progn (vla-put-height txt size) (command "_.Move" (vlax-vla-object->ename txt) "" "_NONE" pt pause) (vla-getboundingbox txt 'minpt 'maxpt) (setq LL (vlax-safearray->list minpt) UR (vlax-safearray->list maxpt) ) (command "_.Rectangle" "_non" LL "_non" UR) (setq pt2 (vlax-curve-getClosestPointTo (entlast) pt)) (entdel (entlast)) (vla-addline mspace (vlax-3d-point pt) (vlax-3d-point pt2)) ;needed (vlax-3d-point (ssdel (vlax-vla-object->ename txt) ss) ) ) ) ) (prompt "\nSelect Text") ) (vla-endundomark doc) (princ) )

The IP address could be some ones old real slow PC somewhere in the world, a bit dangerous from who has it. It is an unknown location. Knowing the IP you could download all the xrefs save local, before starting the dwg. You use FTP some how, talk to your IT. Ps dont post an IP address in full it can be found.

You can use Quick Select > Block reference. under Properties, select NAME in Operator, select *widlcard Match then enter the value *MECH* then just change the color from the pulldown..

I have this as a start for you. I copied the basis from this from somewhere - either this forum of from Lee Mac (I lost the reference, happy to refer to it if anyone knows). Command attnorm puts most blocks as layer 0 and colour byblock. If it was me I would put the blocks on appropriate layers, Arch, MechD, MechW and so on, and use layer colours for the block colours.. then your question will be how to move blocks to a layer dependent on name? (defun c:attnorm (/ myblocklayer myblockcolour myblocklineweight myblocklinetype) (setq myblocklayer "0") (setq myblockcolour 0) ; (setq myblocklineweight aclnwtbyblock) ; (setq myblocklinetype "byblock") (mynorm myblocklayer myblockcolour myblocklineweight myblocklinetype) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:attnormred (/ myblocklayer myblockcolour myblocklineweight myblocklinetype) (setq myblocklayer "0") (setq myblockcolour 10) ; (setq myblocklineweight aclnwtbyblock) ; (setq myblocklinetype "byblock") (mynorm myblocklayer myblockcolour myblocklineweight myblocklinetype) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun mynorm (myblocklayer myblockcolour myblocklineweight myblocklinetype / *error* adoc lst_layer func_restore-layers) (defun *error* (msg) (func_restore-layers) (vla-endundomark adoc) (princ msg) (princ) ) ;_ end of defun (defun func_restore-layers () (foreach item lst_layer (vla-put-lock (car item) (cdr (assoc "lock" (cdr item)))) (vl-catch-all-apply '(lambda () (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))) ) ;_ end of vla-put-freeze ) ;_ end of lambda ) ;_ end of vl-catch-all-apply ) ;_ end of foreach ) ;_ end of defun (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))) ) ;_ end of vla-startundomark (if (and (not (vl-catch-all-error-p (setq selset (vl-catch-all-apply (function (lambda () (ssget '((0 . "INSERT"))) ) ;_ end of lambda ) ;_ end of function ) ;_ end of vl-catch-all-apply ) ;_ end of setq ) ;_ end of vl-catch-all-error-p ) ;_ end of not selset ) ;_ end of and (progn (vlax-for item (vla-get-layers adoc) (setq lst_layer (cons (list item (cons "lock" (vla-get-lock item)) (cons "freeze" (vla-get-freeze item)) ) ;_ end of list lst_layer ) ;_ end of cons ) ;_ end of setq (vla-put-lock item :vlax-false) (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)) ) ;_ end of vl-catch-all-apply ) ;_ end of vlax-for (foreach blk_def (mapcar (function (lambda (x) (vla-item (vla-get-blocks adoc) x) ) ;_ end of lambda ) ;_ end of function ((lambda (/ res) (foreach item (mapcar (function (lambda (x) (vla-get-name (vlax-ename->vla-object x) ) ;_ end of vla-get-name ) ;_ end of lambda ) ;_ end of function ((lambda (/ tab item) (repeat (setq tab nil item (sslength selset) ) ;_ end setq (setq tab (cons (ssname selset (setq item (1- item)) ) ;_ end of ssname tab ) ;_ end of cons ) ;_ end of setq ) ;_ end of repeat tab ) ;_ end of lambda ) ) ;_ end of mapcar (if (not (member item res)) (setq res (cons item res)) ) ;_ end of if ) ;_ end of foreach (reverse res) ) ;_ end of lambda ) ) ;_ end of mapcar (vlax-for ent blk_def ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;Sets the block attributes ;;add in here other attributes to change (vla-put-layer ent myblocklayer) (vla-put-color ent myblockcolour) ;; (vla-put-lineweight ent myblocklineweight) ;; (vla-put-linetype ent myblocklinetype) ;;end of setting up block attributes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ) ;_ end of vlax-for ) ;_ end of foreach (func_restore-layers) (vla-regen adoc acallviewports) ) ;_ end of progn ) ;_ end of if (vla-endundomark adoc) (princ) );_ end of defun

Here is a start ;Writes the difference text1-text2 to text3 (defun C:T1t2 () (setq text1 (entget (car (entsel "\nSelect text 1 ")))) (setq anst1 (atof (cdr (assoc 1 text1)))) (setq text2 (entget (car (entsel "\nSelect text 2 ")))) (setq anst2 (atof(cdr (assoc 1 text2)))) (setq ans (rtos (- anst1 anst2) 2 3)) (setq en (entsel "\nSelect destination text:")) (setq el (entget (car en))) (setq el (subst (cons 1 ans) (assoc 1 el) el)) (entmod el) ;(entupd en) ) end defun (PRINC)