谁能看懂这段代码？

xskfq · 发表于 2014-3-24 10:42:26

(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种。

菜卷鱼 · 发表于 2014-3-24 13:55:46

小伙子，别天真了，你这段代码太高深了，这里没人看得懂

q3_2006 · 发表于 2014-3-24 14:30:35

是不是上个测试图??

wwwliuyu · 发表于 2014-3-24 17:36:34

选择图元类型为"TCH_PIPE"的对象，将对象图层修改为组码301与组码140一起组成的名称，如果该图层不存在则新建。

q3_2006 · 发表于 2014-3-24 18:05:38

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

q3_2006 · 发表于 2014-3-25 07:01:33

颜色有9种...不如直接说说你要对应的颜色号...好写到程序里....

q3_2006 · 发表于 2014-3-25 11:40:41

q3_2006 发表于 2014-3-25 07:01
颜色有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 13:15:40

q3_2006 发表于 2014-3-25 11:40
(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
...

没见过你图什么样...程序只提供思路,后续自己完善!

xyp1964 · 发表于 2014-3-25 13:48:09

;; 未经测试
(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 13:53:24

q3_2006 发表于 2014-3-25 11:40
(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)
  )

账号		自动登录	找回密码
密码			注册

[提问] 谁能看懂这段代码？

相关帖子

点评

点评

点评