谁能看懂这段代码？
(defun c:tzz (/ ss sl i el pr dn lyr addlyr layers)
(vl-load-com)
(defun addlyr (lyr)
(vla-add layers lyr)
)
(if (setq ss (ssget '((0 . "TCH_PIPE"))))
(progn
(setq sl (sslength ss)
i sl
layers (vla-get-layers
(vla-get-activedocument (vlax-get-acad-object))
)
)
(repeat sl
(setq el(entget (ssname ss (setq i (1- i))))
pr(cdr (assoc 301 el))
dn(cdr (assoc 140 el))
lyr (strcat pr (rtos dn 2 0))
)
(if (tblsearch "layer" lyr)
nil
(addlyr lyr)
)
(entmod (subst (cons 8 lyr) (assoc 8 el) el))
)
)
)
(princ)
)
-------------------------------------------------------------------------------------------
这段代码是根据管线的DN值进行分层。如果管线的DN值进行分色不改变原来图层呢。请高手指点，谢谢、
PS:原来管线的DN值有DN25、DN 32、 DN 40、 DN 50、 DN70、 DN80 、 DN 100、 DN150这9种。
小伙子，别天真了，你这段代码太高深了，这里没人看得懂 是不是上个测试图?? 选择图元类型为"TCH_PIPE"的对象，将对象图层修改为组码301与组码140一起组成的名称，如果该图层不存在则新建。 (defun c:tzz ( / dn e el i ss)
(setvar "cmdecho" 0)
(vl-cmdf "undo" "be")
(if (setq ss (ssget "x" '((0 . "TCH_PIPE"))))
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i)))
el (entget e)
dn(cdr (assoc 140 el))
)
(entmod (append el (list (cons 62 (fix dn)))))
)
)
(vl-cmdf "undo" "e")
(setvar "cmdecho" 1)
) 颜色有9种...不如直接说说你要对应的颜色号...好写到程序里.... q3_2006 发表于 2014-3-25 07:01 static/image/common/back.gif
颜色有9种...不如直接说说你要对应的颜色号...好写到程序里....
(defun c:tzz ( / a dn e el i l l1 l2 la lb lst ss x y z)
(defun fd (lst / a la lb x)
(while lst
(setq a (caar lst)
la (vl-remove-if-not '(lambda(x) (= a (car x))) lst)
lst (vl-remove-if '(lambda(x) (= a (car x))) lst)
lb (cons la lb)
)
)
(reverse lb)
)
(setvar "cmdecho" 0)
(vl-cmdf "undo" "be")
(setq l '(7 4 150 5 32 32 1 6 2) ; 颜色表可自行更改
ss (ssget "x" '((0 . "TCH_PIPE")))
l1 nil
)
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i)))
el (entget e)
dn (fix (cdr (assoc 140 el)))
l1 (cons (list dn e) l1)
)
)
(setq l1 (vl-sort l1 '(lambda (x y) (< (car x) (car y))))
l2 (fd l1)
)
(mapcar '(lambda(x y) (mapcar '(lambda(z) (entmod (append (entget (cadr z)) (list (cons 62 y))))) x)) l2 l)
(vl-cmdf "undo" "e")
(setvar "cmdecho" 1)
) q3_2006 发表于 2014-3-25 11:40 static/image/common/back.gif
(defun c:tzz ( / a dn e el i l l1 l2 la lb lst ss x y z)
(defun fd (lst / a la lb x)
(while lst
...
没见过你图什么样...程序只提供思路,后续自己完善!
;; 未经测试
(defun c:tt (/ i ss s1 el pr dn la)
(setq i -1
lst-la '("DN25" "DN32" "DN40" "DN50" "DN65" "DN70" "DN80" "DN100" "DN150")
lst-co '(7 4 150 5 32 32 1 6 2)
)
(if (setq ss (ssget '((0 . "TCH_PIPE"))))
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq el (entget s1)
pr (cdr (assoc 301 el))
dn (cdr (assoc 140 el))
la (strcat pr (rtos dn 2 0))
)
(if (setq n (member la lst-la))(entmod (subst (cons 62 (nth (- 9 (length n)) lst-co)) (assoc 62 el) el)))
)
)
(princ)
) q3_2006 发表于 2014-3-25 11:40 static/image/common/back.gif
(defun c:tzz ( / a dn e el i l l1 l2 la lb lst ss x y z)
(defun fd (lst / a la lb x)
(while lst
...
(defun c:tzz ( / dn e el i ss)
(setvar "cmdecho" 0)
(vl-cmdf "undo" "be")
(if (setq ss (ssget "x" '((0 . "TCH_PIPE"))))
(repeat (setq i (sslength ss))
(setq e (ssname ss (setq i (1- i)))
el (entget e)
dn (fix (cdr (assoc 140 el)))
)
(cond
((= 25 dn) (entmod (append el (list (cons 62 1)))))
((= 32 dn) (entmod (append el (list (cons 62 3)))))
(t (entmod (append el (list (cons 62 7)))))
)
)
)
(vl-cmdf "undo" "e")
(setvar "cmdecho" 1)
)
页:
[1]
2