Process Entities By Portion of Layer Name

[abra-CAD-abra]

I have put together the code below and it is giving me the following error:

 

 

error: bad argument type: lentityp

 

 

Process Entities By Numerical Portion of Layer Name:

 

(defun c:DEMO (/ z s i e ln w)



(vl-load-com)



(defun numbers-from-string (str)
 (defun num-char-p (char)
   (< 48 char 57)
 ) ;_ end of defun
 (vl-list->string
   (vl-remove-if-not
     'num-char-p
     (vl-string->list str)
   ) ;_ end of vl-remove-if-not
 ) ;_ end of vl-list->string
) ;_ end of defun



 (setq z '(100 125 150 175 200 225 250 275 300))
 (if (setq s (ssget ":L" '((0 . "LWPOLYLINE"))))
 
  (repeat (setq i (sslength s))
     (setq e (entget (ssname s (setq i (1- i)))))
 
     (setq ln (cdr (assoc 8 e))
        w  (* (car (member (atoi (numbers-from-string ln)) z)) 0.001)
     ) ;_ end of setq
 
     (vla-put-ConstantWidth (vlax-ename->vla-object e) w )
  
     (ssdel e s)
  
   ) ;_ end of repeat
 ) ;_ end of if
 (princ)
) ;_ end of defun

Can anybody help, please?

 

 

Thanks in advance

Edited May 9, 2017 by abra-CAD-abra

[BIGAL]

Try this, the vlax ename does not like a entget

 

(setq obj (vlax-ename->vla-object (ssname s (setq i (1- i)))))
 (setq ln (vla-get-layer obj)
 ;    (setq ln  ln (cdr (assoc 8 (entget e)))
        w  (* (car (member (atoi (numbers-from-string ln)) z)) 0.001)
     ) ;_ end of setq
(vla-put-ConstantWidth obj w )

[abra-CAD-abra]

Try this, the vlax ename does not like a entget

 

(setq obj (vlax-ename->vla-object (ssname s (setq i (1- i)))))
 (setq ln (vla-get-layer obj)
 ;    (setq ln  ln (cdr (assoc 8 (entget e)))
        w  (* (car (member (atoi (numbers-from-string ln)) z)) 0.001)
     ) ;_ end of setq
(vla-put-ConstantWidth obj w )

 

 

 

Perfect!!!

 

 

Thanks BIGAL

[BIGAL]

No worries I am still learning even after 30 years

[Grrr]

BTW I was still thinking that the NumbersFromString subfunction should be written like this:

 

;_$ (mapcar 'cadr
;   (vl-sort 
;     (vl-remove 'nil
;       (mapcar '(lambda (x / n) (if (setq n (NumberFromString x T)) (list n x) (list 0 x)) )
;         '("A1B" "ABC" "A17" "AB14.5B.C" "DEF" "A1.5B" "A16.BC")
;       )
;     )
;     '(lambda (a b) (< (car a) (car b)))
;   )
; )
; -> ("ABC" "DEF" "A1B" "A1.5B" "AB14.5B.C" "A16.BC" "A17")
; _$ (NumberFromString "12345" nil) -> 12345
; _$ (NumberFromString "12345" T) -> 12345
; _$ (NumberFromString "A.B.C,D,E" nil) -> nil
; _$ (NumberFromString "A.B.C,D,E" T) -> nil
; _$ (NumberFromString "A1.B2.C3,D4,E5" nil) -> 12345
; _$ (NumberFromString "A1.B2.C3,D4,E5" T) -> 1.2345
(defun NumberFromString ( s RetainFirstDot ) 
 (cond 
   ( (not (eq 'STR (type s))) )
   ( (not (vl-some (function (lambda (x) (< 47 x 58))) (vl-string->list s))) (setq s nil) )
   (RetainFirstDot
     (setq s (vl-list->string (vl-remove-if-not (function (lambda (x) (or (= x 46) (< 47 x 58)))) (vl-string->list s))))
     (while (or (= "" s) (and (vl-some (function (lambda (x) (< 47 x 58))) (vl-string->list s)) (not (numberp (read s))))) ; attempt to retain the very first dot, but can return ".."
       (setq s (vl-list->string (reverse (vl-string->list (vl-string-subst "" "." (apply 'strcat (reverse (mapcar 'chr (vl-string->list s)))))))))
     ); while
   ); RetainFirstDot
   ( (setq s (vl-list->string (vl-remove-if-not (function (lambda (x) (< 47 x 58))) (vl-string->list s)))) )
 ); cond
 (cond ((not s) s) ((vl-every '(lambda (x) (= x 46)) (vl-string->list s)) nil)((= "" s) nil) (s (read s)))
); defun NumberFromString

 

Atleast if it has a alphanumerical string sorting purpose.

Edited May 10, 2017 by Grrr
Check should be: (< 47 x 58), not (< 48 x 57) - to include zeros

[Lee Mac]

Here's another version of a 'Numbers from String' function: Parse Numbers - though the desired result for some inputs may depend on the application.

[Grrr]

...though the desired result for some inputs may depend on the application.

 

Thinking carefully, you are very correct about this.

And makes me think to figure out such function:

_$ (foo "1abc-2.3b4cdef56")
(1 "abc" -2.3 "b" 4 "cdef" 56)

That way it could be used more globbaly, so one could rule out/in with which (nth) items to work with.

[abra-CAD-abra]

Thank you all for your assistance.

 

 

Lee/Grrr,

 

 

Since the output layer names only contain a single occurence of a number, for example; "THIS-IS-LAYER-125". I only need to parse that single occurence and I only require numbers (0-9) and not mathematical operators or special characters.

 

 

Lee, I did try your parse numbers function however, it includes mathematical operators such as "-" (minus). I didn't want to start hacking at your code.

 

 

BIGAL,

After a little study and help from Lee's Visual Lisp ActiveX tutorials (http://www.lee-mac.com/selsetprocessing.html#activex), I have updated the code to VLA to avoid the need to convert each entity to its equivalent VLA-Object representation. Great tutorials, Lee!

 

 

(defun c:DEMO (/ z s ln w)

 (vl-load-com)

 (defun numbers-from-string (str)
   (defun num-char-p (char)
     (< 47 char 57)
   ) ;_ end of defun
   (vl-list->string
     (vl-remove-if-not
'num-char-p
(vl-string->list str)
     ) ;_ end of vl-remove-if-not
   ) ;_ end of vl-list->string
 ) ;_ end of defun

(setq z '(100 125 150 175 200 225 250 275 300))

 (if (setq s (ssget "_:L" '((0 . "LWPOLYLINE"))))
   (progn
     (vlax-for o (setq
     s (vla-get-activeselectionset
  (vla-get-activedocument (vlax-get-acad-object))
       ) ;_ end of vla-get-activeselectionset
   ) ;_ end of setq
(setq ln (vla-get-layer o)
      w  (* (car (member (atoi (numbers-from-string ln)) z)) 0.001)
) ;_ end of setq
(vla-put-ConstantWidth o w)
     ) ;_ end of vlax-for
     (vla-delete s)
   ) ;_ end of progn
 ) ;_ end of if
 (princ)
) ;_ end of defun

Edited May 12, 2017 by abra-CAD-abra

[Grrr]

abra-CAD-abra,

 

You don't need to "hack" Lee's code, just manipulate the output a bit:

_$ (LM:parsenumbers "THIS-IS-LAYER-125")
(-125)
_$ (abs (last (LM:parsenumbers "THIS-IS-LAYER-125")))
125
_$ (LM:parsenumbers "Pipes300-Layer-125")
(300 -125)
_$ (abs (last (LM:parsenumbers "Pipes300-Layer-125")))
125

 

Then you could use:

(setq w (* (car (member (abs (last (LM:parsenumbers ln))) z)) 1e-3))

 

However your code should work fine without Lee's function, for the situation you described. Just be careful for a polylines on a layer that does not have numerical occurrence:

 

(and
 (setq ln (vla-get-Layer o))
 (setq w (numbers-from-string ln)) ; _$ (numbers-from-string "layer") -> ""
 (/= "" w) ; _$ (atoi "") -> 0
 (setq w (* (car (member (atoi w) z)) 0.001))
 (vla-put-ConstantWidth o w)
); and

[abra-CAD-abra]

abra-CAD-abra,

 

You don't need to "hack" Lee's code, just manipulate the output a bit:

_$ (LM:parsenumbers "THIS-IS-LAYER-125")
(-125)
_$ (abs (last (LM:parsenumbers "THIS-IS-LAYER-125")))
125
_$ (LM:parsenumbers "Pipes300-Layer-125")
(300 -125)
_$ (abs (last (LM:parsenumbers "Pipes300-Layer-125")))
125

Then you could use:

(setq w (* (car (member (abs (last (LM:parsenumbers ln))) z)) 1e-3))

However your code should work fine without Lee's function, for the situation you described. Just be careful for a polylines on a layer that does not have numerical occurrence:

 

(and
 (setq ln (vla-get-Layer o))
 (setq w (numbers-from-string ln)) ; _$ (numbers-from-string "layer") -> ""
 (/= "" w) ; _$ (atoi "") -> 0
 (setq w (* (car (member (atoi w) z)) 0.001))
 (vla-put-ConstantWidth o w)
); and

 

 

Thanks for your help and advice, Grrr. I will update the code to allow for polylines on layers without a numerical occurence.

 

 

Cheers