Jump to content

highlighting objects


salman

Recommended Posts

The way we place our cursor over an object (without actually clicking) and it becomes highlighted, similarly I want to write code

that highlights certain portion of drawing, so that we can easily view it. For exampe I want to show the flow of water in pipes. If I hightlight the desired portion of pipes, In a drawing having thosands of other objects, the user will be able to easily view flow of water without caring about other objects present in thedrawing.

 

Some users may suggest that I turn off other layers and keep the water pipe layer on, but we need to view the water pipes

while other existing services suchs as ( telephone lines, undergroud electrictiy lines ) are also visible in the drawing.

Link to comment
Share on other sites

Two options for you to play around with:

(defun c:hlight  (/ lLst lay ObjLst grdat iEnt)
 (vl-load-com)
 (vlax-for l
              (vla-get-layers
                (vla-get-ActiveDocument
                  (vlax-get-acad-object)))
   (setq lLst (cons (vla-get-Name l) lLst)))
 (if (and (setq lay (strcase (getstring t "\nSpecify layer to Highlight: ")))
          (member lay (mapcar 'strcase lLst)))
   (progn
     (setq ObjLst (mapcar 'cadr (ssnamex (ssget "_X" (list (cons 8 lay))))))
     (princ "\nMove Cursor Over Objects....")
     (while (eq 5 (car (setq grdat (grread t 4 2))))
       (if (and (setq iEnt (car (nentselp (cadr grdat))))
                (eq lay (strcase (cdr (assoc 8 (entget iEnt))))))
         (mapcar '(lambda (x) (redraw x 3)) ObjLst)
         (mapcar '(lambda (x) (redraw x 4)) ObjLst))))
   (princ "\n<!> Layer not Found <!>"))
 (princ))


(defun c:hlight2  (/ lLst lay ObjLst NulLst grdat iEnt)
 (vl-load-com)
 (vlax-for l
              (vla-get-layers
                (vla-get-ActiveDocument
                  (vlax-get-acad-object)))
   (setq lLst (cons (vla-get-Name l) lLst)))
 (if (and (setq lay (strcase (getstring t "\nSpecify layer to Highlight: ")))
          (member lay (mapcar 'strcase lLst)))
   (progn
     (setq ObjLst (mapcar 'cadr (ssnamex (ssget "_X" (list (cons 8 lay)))))
           NulLst (mapcar 'cadr
                          (ssnamex (ssget "_X"
                                          (list (cons -4 "<NOT")
                                                (cons 8 lay)
                                                (cons -4 "NOT>"))))))
     (princ "\nMove Cursor Over Objects....")
     (while (eq 5 (car (setq grdat (grread t 4 2))))
       (if (and (setq iEnt (car (nentselp (cadr grdat))))
                (eq lay (strcase (cdr (assoc 8 (entget iEnt))))))
         (progn
           (mapcar '(lambda (x) (redraw x 3)) ObjLst)
           (mapcar '(lambda (x) (redraw x 2)) NulLst))
         (progn
           (mapcar '(lambda (x) (redraw x 4)) ObjLst)
           (mapcar '(lambda (x) (redraw x 1)) NulLst)))))
   (princ "\n<!> Layer not Found <!>"))
 (princ))
Type "hlight" or "hlight2" to invoke
Edited by Lee Mac
Link to comment
Share on other sites

This is actually probably more useful:

(defun c:hlight3  (/ lay ObjLst NulLst grdat iEnt)
 (princ "\nMove Cursor Over Objects....")
 (while (eq 5 (car (setq grdat (grread t 4 2))))
   (if (setq iEnt (car (nentselp (cadr grdat))))
     (progn
       (setq lay (strcase (cdr (assoc 8 (entget iEnt)))))
       (setq ObjLst (mapcar 'cadr (ssnamex (ssget "_X" (list (cons 8 lay)))))
             NulLst (mapcar 'cadr
                            (ssnamex (ssget "_X"
                                            (list (cons -4 "<NOT")
                                                  (cons 8 lay)
                                                  (cons -4 "NOT>"))))))
       (mapcar '(lambda (x) (redraw x 3)) ObjLst)
       (mapcar '(lambda (x) (redraw x 2)) NulLst))
     (if (and ObjLst NulLst)
       (progn
         (mapcar '(lambda (x) (redraw x 4)) ObjLst)
         (mapcar '(lambda (x) (redraw x 1)) NulLst)))))
 (princ))
 

Type "hlight3" to invoke

Edited by Lee Mac
Link to comment
Share on other sites

Another method:

Issue a regen to un highlite

;;=============================================================
;;     Sel.lsp by Charles Alan Butler
;;            Copyright 2004
;;   by Precision Drafting & Design All Rights Reserved.
;;   Contact at ab2draft@TampaBay.rr.com
;; 
;;    Version 1.0 Beta  July 23,2004
;;    Version 1.1 Beta  July 13,2005
;;
;;   Creates a selection set of objects on a layer(s)
;;   User picks objects to determine the layer(s)
;;   Then User selects objects for ss or presses enter to 
;;   get all objects on the selected layer(s)
;;   You may select the selection set before starting this
;;   routine. Then select the layers to keep in the set
;;=============================================================
(defun c:sel (/ ent lay ss lay:lst lay:prompt ss:first ent:lst)
 
;;  An integer value that controls the visibility and highlighting of the entity. 
;;  The mode can be one of the following values:
;;  1  Show entity
;;  2  Hide entity (blank it out)
;;  3  Highlight entity
;;  4  Unhighlight entity

(defun ssredraw ( ss mode / i ename vlaobj)
 (and (eq 'pickset (type ss)) 
      (setq i -1)
      (while (setq ename (ssname ss (setq i (1+ i))))
          (setq vlaobj (vlax-ename->vla-object (ssname ss i))) 
          (vla-Highlight vlaobj :vlax-true) 
          (vla-update vlaobj) 
      )
 )
)
 
 ;;  get anything already selected
 (setq ss:first (cadr(ssgetfirst))
       ss (ssadd))

 ;;  Get user selected layers
 (if ss:first
   (setq lay:prompt "\nSelect the object to choose layers to keep.")
   (setq lay:prompt "\nSelect object(s) for layer filter. ENTER to continue.")
 )
 (while (setq ent (entsel lay:prompt))
   (setq ent:lst (cons (car ent) ent:lst))
   (setq lay:lst
          (cons (setq lay (cdr(assoc 8 (entget (car ent))))) lay:lst))
   (prompt (strcat "\n*-* Selected Layer -> " lay))
 )
 ;;  Un HighLite the entities
 (and ent:lst (mapcar '(lambda (x) (redraw x 4)) ent:lst))

 (if (> (length lay:lst) 0); got layers to work with
   (progn
     (setq lay "")
     (setq lay:lst (vl-sort lay:lst '<)) ; removes douplicates
     (foreach itm  lay:lst ; combine lay names into one , del string
       (setq lay (strcat lay itm ",")))
     (setq lay (substr lay 1 (1- (strlen lay)))); remove the last ,
     (if ss:first ; ALREADY GOT SELECTION SET
       (while (setq ent (ssname ss:first 0))
         (if (member (cdr(assoc 8 (entget ent))) lay:lst)
           (ssadd (ssname ss:first 0) ss)
         )
         (ssdel (ssname ss:first 0) ss:first)
       )
       (progn ; else get a selection set to work with
         (prompt (strcat "\nOK >>--> Select objects for Selection set or "
                         "ENTER for All objects on layer(s) " lay))
         ;;  get objects using filter with user select
         (if (null (setq ss (ssget (list (cons 8 lay)))))
           ;; or get ALL objects in current space using filter
           (setq ss (ssget "_X" (list (cons 8 lay)(cons 410 (getvar "ctab")))))
         )
       )
     )
     (if (> (sslength ss) 0)
       (progn
         (prompt (strcat "\n" (itoa (sslength ss))
                     " Object(s) selected on layer(s) " lay
                     "\nStart an ACAD command, REGEN to un highlite."))
         (ssredraw ss 3)
       )
       (prompt "\n***  Nothing Selected  ***")
     )
   )
 )
 (princ)
)
(prompt "\nSelect on Layer loaded, Enter Sel to run.")
(princ)

Link to comment
Share on other sites

  • 12 years later...
On 5/10/2009 at 9:00 PM, Lee Mac said:

Two options for you to play around with:


(defun c:hlight  (/ lLst lay ObjLst grdat iEnt)
 (vl-load-com)
 (vlax-for l
              (vla-get-layers
                (vla-get-ActiveDocument
                  (vlax-get-acad-object)))
   (setq lLst (cons (vla-get-Name l) lLst)))
 (if (and (setq lay (strcase (getstring t "\nSpecify layer to Highlight: ")))
          (member lay (mapcar 'strcase lLst)))
   (progn
     (setq ObjLst (mapcar 'cadr (ssnamex (ssget "_X" (list (cons 8 lay))))))
     (princ "\nMove Cursor Over Objects....")
     (while (eq 5 (car (setq grdat (grread t 4 2))))
       (if (and (setq iEnt (car (nentselp (cadr grdat))))
                (eq lay (strcase (cdr (assoc 8 (entget iEnt))))))
         (mapcar '(lambda (x) (redraw x 3)) ObjLst)
         (mapcar '(lambda (x) (redraw x 4)) ObjLst))))
   (princ "\n<!> Layer not Found <!>"))
 (princ))


(defun c:hlight2  (/ lLst lay ObjLst NulLst grdat iEnt)
 (vl-load-com)
 (vlax-for l
              (vla-get-layers
                (vla-get-ActiveDocument
                  (vlax-get-acad-object)))
   (setq lLst (cons (vla-get-Name l) lLst)))
 (if (and (setq lay (strcase (getstring t "\nSpecify layer to Highlight: ")))
          (member lay (mapcar 'strcase lLst)))
   (progn
     (setq ObjLst (mapcar 'cadr (ssnamex (ssget "_X" (list (cons 8 lay)))))
           NulLst (mapcar 'cadr
                          (ssnamex (ssget "_X"
                                          (list (cons -4 "<NOT")
                                                (cons 8 lay)
                                                (cons -4 "NOT>"))))))
     (princ "\nMove Cursor Over Objects....")
     (while (eq 5 (car (setq grdat (grread t 4 2))))
       (if (and (setq iEnt (car (nentselp (cadr grdat))))
                (eq lay (strcase (cdr (assoc 8 (entget iEnt))))))
         (progn
           (mapcar '(lambda (x) (redraw x 3)) ObjLst)
           (mapcar '(lambda (x) (redraw x 2)) NulLst))
         (progn
           (mapcar '(lambda (x) (redraw x 4)) ObjLst)
           (mapcar '(lambda (x) (redraw x 1)) NulLst)))))
   (princ "\n<!> Layer not Found <!>"))
 (princ))
Type "hlight" or "hlight2" to invoke

the code highlight all the objects in the same layer and hide the others, theres a way just to highlight the object the cursor is over to show whitch line you will get selected if you click?

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...