按部分处理实体
我把下面的代码放在一起,它给了我以下错误:错误:错误的参数类型:lentyp
按图层名称的数字部分处理实体:
(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
有人能帮忙吗?
提前感谢 试试这个,vlax ename不喜欢entget
(setq obj (vlax-ename->vla-object (ssname s (setq i (1- i)))))
(setq ln (vla-get-layer obj)
; (setq lnln (cdr (assoc 8 (entget e)))
w(* (car (member (atoi (numbers-from-string ln)) z)) 0.001)
) ;_ end of setq
(vla-put-ConstantWidth obj w )
完美的
谢谢BIGAL 不用担心,即使过了30年,我仍在学习 顺便说一句,我仍然认为NumbersFromString子函数应该这样写:
;_$ (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)
这样可以更广泛地使用它,因此可以排除/使用哪个(第n个)项。 谢谢大家的帮助。
李/Grrr,
例如,由于输出层名称仅包含数字的一次出现;“THIS-IS-LAYER-125”。我只需要解析那个单一出现,我只需要数字(0-9),而不需要数学运算符或特殊字符。
李,我确实试过你的解析数函数,但是,它包括数学运算符,比如“-”(负号)。我不想开始破解你的代码。
比加尔,
经过李的Visual Lisp ActiveX教程的学习和帮助(http://www.lee-mac.com/selsetprocessing.html#activex),我已将代码更新为VLA,以避免需要将每个实体转换为其等效的VLA对象表示。很棒的教程,李!
(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
abra CAD abra,
你不需要“破解”李的代码,只需稍微操作一下输出:
_$ (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))
然而,对于您描述的情况,如果没有Lee的函数,您的代码应该可以正常工作。只需注意图层上没有数字引用的多段线:
(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
谢谢你的帮助和建议,Grrr。我将更新代码,以允许层上的多段线不出现数字。
干杯
页:
[1]