[编程交流] 按部分处理实体

(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

(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 )

;_$ (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

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

(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

_$ (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

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

(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