Filter polyline selection by Z value

[chulse]

Oh man..

 (strcat "Lay" (itoa (fix elv)))

(strcat "E-TOPO-" (itoa (fix elv)))

 

Kudos to David

 

 

I had set it up that way so it would be easy to change in the future if the project stadards required a different layer naming convention.

 

Besides, wouldn't that make the layer unique or each separate elevation vs. putting all the index contours (any multiples of 10) in the same layer?

[Lee Mac]

How do we test for the z value being a multiple of 10 though? I don't understand how that is happening...

 

Consider the method utilised in David's code:

 

(defun c:topten (/ ss en)
 (setq s1 (ssadd))
 (and (setq ss (ssget '((0 . "LWPOLYLINE"))))
      (while (setq en (ssname ss 0))
             (if (zerop (rem (cdr (assoc 38 (entget en))) 10))
                 (ssadd en s1))
             (ssdel en ss)))

s1)

Specifically, this line:

 

[b][color=GREEN]([/color][/b]zerop [b][color=BLUE]([/color][/b]rem [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 38 [b][color=TEAL]([/color][/b]entget en[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b] 10[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]

Breaking this down into its individual expressions, we first have:

 

(cdr (assoc 38 (entget en)))

As you may have gathered, the DXF 38 group code is the elevation of the LWPolyline, hence the above expression returns this elevation value.

 

Substituting this knowledge into the original expression, we have:

 

(zerop (rem [color=red]<Elevation>[/color] 10))

Now study the rem function in more detail.

 

From the Visual LISP IDE Help Docs:

 

rem

 

Divides the first number by the second, and returns the remainder.

 

([color=blue]rem [/color][color=darkred][number number...][/color])

Arguments

 

number

Any number.

 

Return Values

 

A number. If any number argument is a real, rem returns a real; otherwise, rem returns an integer. If no arguments are supplied, rem returns 0. If a single number argument is supplied, rem returns number.

 

Now that we know what the rem function is doing, let us take a look at the zerop function, which is operating on the result of the rem function:

 

zerop

 

Verifies that a number evaluates to zero.

 

([color=blue]zerop [/color][color=darkred]number[/color])

Arguments

 

number

A number.

 

Return Values

 

T if number evaluates to zero; otherwise nil.

 

Hence, in conclusion, the rem function returns the remainder from dividing the elevation by 10, then the zerop function returns T if such remainder is zero, i.e. if the elevation is a multiple of 10.

 

If ever you want to understand what a line of code is doing, break the line down, expression by expression and study each function that is being evaluated, and what that function is returning as a result.

 

[ EDIT: Looks like I am too slow at typing! ]

[chulse]

Thanks Lee, I can always use a lesson

[chulse]

Thanks guys for all the help.

This is the fully functional version.

 

The only thing I haven't figured out yet is why the FOREACH wasn't working to set the layer... but David's command version works perfectly. Thanks again.

 

(defun C:SCL (/ *error* msg ELEV SS LAY2 LAY10 DOC UFLAG ALL obj temp s1 en)
 
 ;layer name used for 10' contours
 (setq lay10 "E-TOPO-10")
 
 ;layer name used for 2' contours
 (setq lay2 "E-TOPO-2")
 
   (vl-load-com)
 (setq DOC (vla-get-ActiveDocument (vlax-get-acad-object)))

 ;; --{  Error Handler Function by Lee Mac }--
 (defun *error* (msg)     
   (and uflag (vla-EndUndoMark doc))
   
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")        
       (princ (strcat "\n** Error: " msg " **")))    
   (princ))  

 ;; --{  Main Function  }-- 
 (setq uflag (not (vla-StartUndoMark doc)))
 
 ;;; CHECK FOR LAYER AND ADD IF NOT EXIST
           (or (tblsearch "LAYER" LAY10)
           (vla-add (vla-get-layers doc) LAY10))
           
           (or (tblsearch "LAYER" LAY2)
           (vla-add (vla-get-layers doc) LAY2))
           
   ;put all obj on 2' contour layer        
  (setq all (ssget "_X" '((0 . "LWPOLYLINE") )))         
           
;;;            (foreach obj all
;;;            (vla-put-layer (vlax-ename->vla-object obj) LAY2)
;;;            );_end foreach
   (command "_.CHPROP" all "" "_LA" lay2 "")
   
;(find all contours from 10 to 10000 by 10)
   
 ; (setq elev 10 ss (ssadd))
 ; (while 
 ; (<= elev 10000);max elevation searched for is 10,000 feet - change if need be
   ; (if (setq temp (ssget "_X" (List '(0 . "LWPOLYLINE") (cons 38 elev))))
; (repeat (setq i (sslength temp))
     ; (ssadd  (ssname temp (setq i (1- i))) ss)))
        ; (setq elev (+ elev 10))
 ; );_end while
 
   (setq s1 (ssadd))
 (and (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
      (while (setq en (ssname ss 0))
             (if (zerop (rem (cdr (assoc 38 (entget en))) 10))
                 (ssadd en s1))
             (ssdel en ss)))
       ;;;s1)
 
 ;put 10' contours on correct new layer
;;;            (foreach obj S1
;;;            (vla-put-layer obj Lay10)
;;;            );_end foreach
    (command "_.CHPROP" s1 "" "_LA" lay10 "")
   
   ;clear ss
   (setq s1 nil)
    (setq all nil)   
 (setq uFlag (vla-EndUndoMark doc))
 (princ)
 );_end defun

[pBe]

,,,,, putting all the index contours (any multiples of 10) in the same layer?

 

Thats exactly what the code is doing , [see code at post # 16] with that approach you eliminate the need for . (ssadd)

For every DXF 38 value found to be true undet the condition [as explained by DB and LM] it wiil assign a layer name equiivalent to your naming convention.

Say first item on selection sets elevation is at 10.0 , which means the condtion is true , it then converts the dxf value of 10.0 to "10" and pass the argument for strcat to make "E-TOPO-10". so same goes of every TRUE statement. DXF 38 value 50.0 to "E-TOPO-50".

The layer name will depend on the elevation value. which means a dxf value of 10 will still be assinged to "E-TOPO-10".

 

Got it?

[David Bethel]

 

[ EDIT: Looks like I am too slow at typing! ]

 

Nah... You're just a lot more thorough. -David

[David Bethel]

Building on Davids code

....
             (if (zerop (rem [color=blue][b](setq elv[/b][/color] (cdr (assoc 38 [color=blue][b](setq e[/b][/color] (entget en))))) 10))
                [color=blue][b](entmod (subst (cons 8 (strcat [color=darkgreen]"E-TOPO-"[/color] (itoa (fix elv))))[/b][/color]
[b][color=blue]                           (assoc 8 e) e))[/color][/b]
)

 

I like that. Nice and neat yet still human readable. -David

[pBe]

ohhhh geez.. I see what you mean cary , exlcusively "E-TOPO-10" which means intervals of 10. My bad then.

 

so it should be

[b][color=#0000ff](entmod (subst (cons 8 [/color][color=darkgreen]"E-TOPO-10")[/color][/b]
[b][color=blue]                           (assoc 8 e) e))[/color][/b]
                 )

 

Im not for really cut CIVIL works

Apologies guys

[pBe]

I like that. Nice and neat yet still human readable. -David

 

Never got around writing "color syntax" myself and stick with them available toolbars.

 

Kudos to you David for that condtional statement construct

[chulse]

Ahh, very nice. I'll continue to refine it, but it's functional now. It'll save hours of work (... goes out for a beer )

[KraZeyMike]

On 29/04/2012 at 00:57, chulse said:

Thanks guys for all the help.

This is the fully functional version.

 

The only thing I haven't figured out yet is why the FOREACH wasn't working to set the layer... but David's command version works perfectly. Thanks again.

 

 

(defun C:SCL (/ *error* msg ELEV SS LAY2 LAY10 DOC UFLAG ALL obj temp s1 en)
 
 ;layer name used for 10' contours
 (setq lay10 "E-TOPO-10")
 
 ;layer name used for 2' contours
 (setq lay2 "E-TOPO-2")
 
   (vl-load-com)
 (setq DOC (vla-get-ActiveDocument (vlax-get-acad-object)))

 ;; --{  Error Handler Function by Lee Mac }--
 (defun *error* (msg)     
   (and uflag (vla-EndUndoMark doc))
   
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")        
       (princ (strcat "\n** Error: " msg " **")))    
   (princ))  

 ;; --{  Main Function  }-- 
 (setq uflag (not (vla-StartUndoMark doc)))
 
 ;;; CHECK FOR LAYER AND ADD IF NOT EXIST
           (or (tblsearch "LAYER" LAY10)
           (vla-add (vla-get-layers doc) LAY10))
           
           (or (tblsearch "LAYER" LAY2)
           (vla-add (vla-get-layers doc) LAY2))
           
   ;put all obj on 2' contour layer        
  (setq all (ssget "_X" '((0 . "LWPOLYLINE") )))         
           
;;;            (foreach obj all
;;;            (vla-put-layer (vlax-ename->vla-object obj) LAY2)
;;;            );_end foreach
   (command "_.CHPROP" all "" "_LA" lay2 "")
   
;(find all contours from 10 to 10000 by 10)
   
 ; (setq elev 10 ss (ssadd))
 ; (while 
 ; (<= elev 10000);max elevation searched for is 10,000 feet - change if need be
   ; (if (setq temp (ssget "_X" (List '(0 . "LWPOLYLINE") (cons 38 elev))))
; (repeat (setq i (sslength temp))
     ; (ssadd  (ssname temp (setq i (1- i))) ss)))
        ; (setq elev (+ elev 10))
 ; );_end while
 
   (setq s1 (ssadd))
 (and (setq ss (ssget "_X" '((0 . "LWPOLYLINE"))))
      (while (setq en (ssname ss 0))
             (if (zerop (rem (cdr (assoc 38 (entget en))) 10))
                 (ssadd en s1))
             (ssdel en ss)))
       ;;;s1)
 
 ;put 10' contours on correct new layer
;;;            (foreach obj S1
;;;            (vla-put-layer obj Lay10)
;;;            );_end foreach
    (command "_.CHPROP" s1 "" "_LA" lay10 "")
   
   ;clear ss
   (setq s1 nil)
    (setq all nil)   
 (setq uFlag (vla-EndUndoMark doc))
 (princ)
 );_end defun

 

 

 

 

Thankyou for this, is there any chance of modifying it for a 2DPolyline and only filtering on a specific wildcard layer.

 

IE. Command runs only on the wildcard *Contour* layers

 

I tried changing LWPOLYLINE to *POLYLINE with no luck, only changes everything to a minor contour.

Edited July 26 by KraZeyMike