abra-CAD-abra 发表于 2022-7-5 16:22:56

按部分处理实体

我把下面的代码放在一起,它给了我以下错误:
 
 
错误:错误的参数类型: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




有人能帮忙吗?
 
 
提前感谢

BIGAL 发表于 2022-7-5 16:33:11

试试这个,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 )

abra-CAD-abra 发表于 2022-7-5 16:36:48

 
 
 
完美的
 
 
谢谢BIGAL

BIGAL 发表于 2022-7-5 16:46:33

不用担心,即使过了30年,我仍在学习

Grrr 发表于 2022-7-5 16:54:17

顺便说一句,我仍然认为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
 
如果它具有字母数字字符串排序目的,则至少是这样。

Lee Mac 发表于 2022-7-5 16:56:50

下面是“字符串中的数字”函数的另一个版本:解析数字-尽管某些输入的预期结果可能取决于应用程序。

Grrr 发表于 2022-7-5 17:05:24

 
仔细想想,你是对的。
让我想弄清楚这样的函数:

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

这样可以更广泛地使用它,因此可以排除/使用哪个(第n个)项。

abra-CAD-abra 发表于 2022-7-5 17:14:21

谢谢大家的帮助。
 
 
李/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

Grrr 发表于 2022-7-5 17:22:13

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

abra-CAD-abra 发表于 2022-7-5 17:23:30

 
 
谢谢你的帮助和建议,Grrr。我将更新代码,以允许层上的多段线不出现数字。
 
 
干杯
页: [1]
查看完整版本: 按部分处理实体