急求按顺序打断线条的程序！！！

etoxp · 发表于 2015-8-29 18:38:17

从优先纸最高的图层开始遍历，只会新产生低优先级的图元。这样程序运行速度会快很多。

etoxp · 发表于 2015-8-29 18:44:20

貌似楼主用于表示管线遮挡用

theisland · 发表于 2015-8-29 18:51:54

etoxp 发表于 2015-8-29 18:44
貌似楼主用于表示管线遮挡用

对，就是这个作用，表达一种遮挡关系

vectra · 发表于 2015-8-29 21:27:39

没有做交互程序，使用时自行设置图层及断线宽度两个参数
开始觉得蛮简单，实际还是有点复杂的，借用了不少论坛里的代码，封闭曲线暂时不能处理。
未经严格测试。

(setq *layer-sequence* '("图层1" "图层2" "图层3" "图层4" "图层5" "图层6" "图层7")
*break-width* 200.0
)
(defun select-curves (/ ent i n rt ss)
(setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE")))
i 0
n (sslength ss)
)
(repeat n
(setq ent (ssname ss i)
rt (cons (list ent
(cdr (assoc 8 (entget ent)))
)
rt
)
i (1+ i)
)
)
;; (<图元名: -24a300> "图层2")
;; ...
rt
)
(defun append-break-point (lst layerorder / ipts old pts rt)
(foreach e1 lst
(foreach e2 (cdr lst)
;; 图层不打断
(if (< (vl-position (cadr e1) layerorder) (vl-position (cadr e2) layerorder))
(progn
(setq ipts (vlax-variant-value
(vla-intersectwith
(vlax-ename->vla-object (car e1))
(vlax-ename->vla-object (car e2))
0
)
)
)
(if (> (vlax-safearray-get-u-bound ipts 1) 0)
(progn
(setq ipts (vlax-safearray->list ipts))
(while ipts
(setq pts (cons (list (car ipts)
(cadr ipts)
(caddr ipts)
)
pts
)
ipts (cdddr ipts)
)
)
(if (setq old (assoc (car e2) rt))
(setq rt (subst (append old pts) old rt))
(setq rt (cons (cons (car e2) pts) rt))
)
(setq pts nil)
)
)
)
)
)
)
;; (<图元名: -2306e0> (-224414.0 66920.2 0.0) (-224414.0 65920.2 0.0))..
;; ...
rt
)
(defun v-length (v /)
(sqrt (apply '+ (mapcar '(lambda (e) (* e e)) v)))
)
(defun v-normal (v / len)
(setq len (v-length v))
(if (/= 0 len)
(mapcar '(lambda (e) (/ e len)) v)
'(0.0 0.0 0.0)
)
)
;;; Author: Copyright? 2006,2007 Charles Alan Butler
;;; Contact @ www.TheSwamp.org
(defun break_obj (ent brkptlst / brkobjlst closedobj deriv e enttype obj obj2break)
(setq obj2break ent
brkobjlst (list ent)
enttype (cdr (assoc 0 (entget ent)))
)
(foreach brkpt brkptlst ; get last entity created via break
; in case multiple breaks
(if brkobjlst
(progn ; if pt not on object x, switch
; objects
(if (not (numberp (vl-catch-all-apply
'vlax-curve-getdistatpoint
(list obj2break brkpt)
)
)
)
(foreach obj brkobjlst ; find the one that pt is on
(if (numberp (vl-catch-all-apply
'vlax-curve-getdistatpoint
(list obj brkpt)
)
)
(setq obj2break obj) ; switch objects
)
)
)
)
)
(setq
obj (vlax-ename->vla-object obj2break)
deriv (vlax-curve-getfirstderiv obj (vlax-curve-getparamatpoint obj brkpt))
deriv (v-normal deriv)
deriv (mapcar '(lambda (e) (* e (/ *break-width* 2.0))) deriv)
)
(setq closedobj (vlax-curve-isclosed obj2break))
(command "._break"
obj2break
"_non"
(trans (mapcar '+ brkpt deriv) 0 1)
"_non"
(trans (mapcar '- brkpt deriv) 0 1)
)
(if (not closedobj) ; new object was created
(setq brkobjlst (cons (entlast) brkobjlst))
)
)
)
(defun c:tt (/ rt)
(setvar "CMDECHO" 0)
(setq rt (append-break-point
(select-curves)
*layer-sequence*
)
)
(command ".undo" "BE")
(foreach e rt
(break_obj (car e) (cdr e))
)
(command ".undo" "E")
(setvar "CMDECHO" 1)
(princ)
)

(setq *layer-sequence* '("图层1" "图层2" "图层3" "图层4" "图层5" "图层6" "图层7") 
      *break-width*    200.0 
) 
 
 
(defun select-curves (/ ent i n rt ss) 
 
  (setq        ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))) 
        i  0 
        n  (sslength ss) 
  ) 
  (repeat n 
    (setq ent (ssname ss i) 
          rt  (cons (list ent 
                          (cdr (assoc 8 (entget ent))) 
                    ) 
                    rt 
              ) 
          i   (1+ i) 
    ) 
  ) 
 
  ;; (<图元名: -24a300> "图层2") 
  ;; ... 
  rt 
) 
 
 
(defun append-break-point (lst layerorder / ipts old pts rt) 
  (foreach e1 lst 
    (foreach e2        (cdr lst) 
 
      ;; 图层不打断 
      (if (< (vl-position (cadr e1) layerorder) (vl-position (cadr e2) layerorder)) 
        (progn 
          (setq        ipts (vlax-variant-value 
                       (vla-intersectwith 
                         (vlax-ename->vla-object (car e1)) 
                         (vlax-ename->vla-object (car e2)) 
                         0 
                       ) 
                     ) 
          ) 
 
          (if (> (vlax-safearray-get-u-bound ipts 1) 0) 
            (progn 
              (setq ipts (vlax-safearray->list ipts)) 
              (while ipts 
                (setq pts  (cons (list (car ipts) 
                                       (cadr ipts) 
                                       (caddr ipts) 
                                 ) 
                                 pts 
                           ) 
                      ipts (cdddr ipts) 
                ) 
              ) 
              (if (setq old (assoc (car e2) rt)) 
                (setq rt (subst (append old pts) old rt)) 
                (setq rt (cons (cons (car e2) pts) rt)) 
              ) 
              (setq pts nil) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
 
  ;; (<图元名: -2306e0> (-224414.0 66920.2 0.0) (-224414.0 65920.2 0.0)).. 
  ;; ... 
  rt 
) 
 
 
 
(defun v-length        (v /) 
  (sqrt (apply '+ (mapcar '(lambda (e) (* e e)) v))) 
) 
 
 
(defun v-normal        (v / len) 
  (setq len (v-length v)) 
  (if (/= 0 len) 
    (mapcar '(lambda (e) (/ e len)) v) 
    '(0.0 0.0 0.0) 
  ) 
) 
 
 
;;; Author: Copyright? 2006,2007 Charles Alan Butler 
;;; Contact @  <a href="http://www.TheSwamp.org" target="_blank">www.TheSwamp.org</a> 
(defun break_obj (ent brkptlst / brkobjlst closedobj deriv e enttype obj obj2break) 
  (setq        obj2break ent 
        brkobjlst (list ent) 
        enttype          (cdr (assoc 0 (entget ent))) 
  ) 
  (foreach brkpt brkptlst                ;  get last entity created via break 
                                        ; in case multiple breaks 
    (if        brkobjlst 
      (progn                                ;  if pt not on object x, switch 
                                        ; objects 
        (if (not (numberp (vl-catch-all-apply 
                            'vlax-curve-getdistatpoint 
                            (list obj2break brkpt) 
                          ) 
                 ) 
            ) 
          (foreach obj brkobjlst        ; find the one that pt is on 
            (if        (numberp (vl-catch-all-apply 
                           'vlax-curve-getdistatpoint 
                           (list obj brkpt) 
                         ) 
                ) 
              (setq obj2break obj)        ; switch objects 
            ) 
          ) 
        ) 
      ) 
    ) 
 
    (setq 
      obj   (vlax-ename->vla-object obj2break) 
      deriv (vlax-curve-getfirstderiv obj (vlax-curve-getparamatpoint obj brkpt)) 
      deriv (v-normal deriv) 
      deriv (mapcar '(lambda (e) (* e (/ *break-width* 2.0))) deriv) 
    ) 
 
 
    (setq closedobj (vlax-curve-isclosed obj2break)) 
    (command "._break" 
             obj2break 
             "_non" 
             (trans (mapcar '+ brkpt deriv) 0 1) 
             "_non" 
             (trans (mapcar '- brkpt deriv) 0 1) 
    ) 
    (if        (not closedobj)                        ; new object was created 
      (setq brkobjlst (cons (entlast) brkobjlst)) 
    ) 
  ) 
) 
 
 
(defun c:tt (/ rt) 
  (setvar "CMDECHO" 0) 
 
  (setq        rt (append-break-point 
             (select-curves) 
             *layer-sequence* 
           ) 
  ) 
 
  (command ".undo" "BE") 
  (foreach e rt 
    (break_obj (car e) (cdr e)) 
  ) 
  (command ".undo" "E") 
 
  (setvar "CMDECHO" 1) 
  (princ) 
)

theisland · 发表于 2015-8-29 23:10:03

本帖最后由 theisland 于 2015-8-29 23:13 编辑

vectra 发表于 2015-8-29 21:27
没有做交互程序，使用时自行设置图层及断线宽度两个参数
开始觉得蛮简单，实际还是有点复杂的，借用了不少 ...

非常感谢！基本能满足使用要求了，如果能临时指定打断距离，以及临时点选图层顺序的话就完美了！
闭合曲线实际工作中用不着，不用考虑，
希望框选时，指定图层之外的其他对象不被选择，
程序里面的图层罗列，有更好的格式吗？比如说弄成一行一行的格式，更方便编辑
盼你完善一下就好了，强烈期待啊！

etoxp · 发表于 2015-8-29 23:44:47

本帖最后由 etoxp 于 2015-8-30 00:01 编辑

或许也可以这样做：
直接画成三维的，然后用flatshot命令画出俯视图，可以体现出遮挡效果。
也可以在布局里面绘图，在一个视口里展现三维模型的俯视图。

theisland · 发表于 2015-8-30 00:46:31

etoxp 发表于 2015-8-29 23:44
或许也可以这样做：
直接画成三维的，然后用flatshot命令画出俯视图，可以体现出遮挡效果。
也可以在布局 ...

这样就整复杂了~~

theisland · 发表于 2015-8-30 06:31:35

llsheng_73 发表于 2015-8-30 02:51
郁闷死了，上传不了图片也传不了附件，该死的IE11?
命令tt,用测试图测试没发现问题，可以调整图层顺序（ ...

你这个思路很不错，更好用，问题是如果图中图层很多，你的程序一下子读取太多无关图层出来，反而不方便操作；如果能在你这个基础上增加一些默认图层及其排序就太好了！程序里面的图层列表要便于编辑，对话框里面增加一个“点选添加图层”按钮，可以临时补充程序中没有列出的新图层，强烈期待！

llsheng_73 · 发表于 2015-8-30 09:12:19

本帖最后由 llsheng_73 于 2015-8-30 09:13 编辑

theisland 发表于 2015-8-30 06:31
你这个思路很不错，更好用，问题是如果图中图层很多，你的程序一下子读取太多无关图层出来，反而不方便操 ...

今天要出去，晚上回来再加上可以在图形中选择一些图层，另外增加一个反选。。。
另外列表是可以多选并能移除，所以无关图层太多的问题应该不是太大问题。。。。

vectra · 发表于 2015-8-30 09:46:29

本帖最后由 vectra 于 2015-8-30 09:52 编辑

增加了交互部分

(setq *layer-sequence* '("图层1" "图层2" "图层3" "图层4" "图层5" "图层6" "图层7")
*break-width* 200.0
)
(defun strcatlayernames (layernames / a)
(setq a (car layernames)
layernames (cdr layernames)
)
(while layernames
(setq a (strcat a "," (car layernames))
layernames (cdr layernames)
)
)
a
)
(defun select-layer-sequence (/ en rt)
(while (setq en (entsel "选择对象:"))
(setq rt (cons (cdr (assoc 8 (entget (car en)))) rt))
)
(setq *layer-sequence* (reverse rt))
)
(defun get-break-dist (/ rt)
(setq rt (getdist
(strcat "\n输入断开间距 <" (rtos *break-width* 2 2) ">: ")
)
)
(if (not (null rt))
(setq *break-width* rt)
)
)
(defun select-curves (/ ent i n rt ss)
(setq ss (ssget (list '(0 . "*LINE,ARC,CIRCLE,ELLIPSE")
(cons 8 (strcatlayernames *layer-sequence*))
)
)
i 0
n (sslength ss)
)
(repeat n
(setq ent (ssname ss i)
rt (cons (list ent
(cdr (assoc 8 (entget ent)))
)
rt
)
i (1+ i)
)
)
;; (<图元名: -24a300> "图层2")
;; ...
rt
)
(defun append-break-point (lst layerorder / ipts old pts rt)
(foreach e1 lst
(foreach e2 (cdr lst)
;; 图层不打断
(if (< (vl-position (cadr e1) layerorder) (vl-position (cadr e2) layerorder))
(progn
(setq ipts (vlax-variant-value
(vla-intersectwith
(vlax-ename->vla-object (car e1))
(vlax-ename->vla-object (car e2))
0
)
)
)
(if (> (vlax-safearray-get-u-bound ipts 1) 0)
(progn
(setq ipts (vlax-safearray->list ipts))
(while ipts
(setq pts (cons (list (car ipts)
(cadr ipts)
(caddr ipts)
)
pts
)
ipts (cdddr ipts)
)
)
(if (setq old (assoc (car e2) rt))
(setq rt (subst (append old pts) old rt))
(setq rt (cons (cons (car e2) pts) rt))
)
(setq pts nil)
)
)
)
)
)
)
;; (<图元名: -2306e0> (-224414.0 66920.2 0.0) (-224414.0 65920.2 0.0))..
;; ...
rt
)
(defun v-length (v /)
(sqrt (apply '+ (mapcar '(lambda (e) (* e e)) v)))
)
(defun v-normal (v / len)
(setq len (v-length v))
(if (/= 0 len)
(mapcar '(lambda (e) (/ e len)) v)
'(0.0 0.0 0.0)
)
)
;;; Contact @ <a rel=\"nofollow\" href=\"/plugin.php?id=laoyang_wailianx&url=http://www.TheSwamp.org\" target=\"_blank\">www.TheSwamp.org</a>
(defun break_obj (ent brkptlst / brkobjlst closedobj deriv e enttype obj obj2break)
(setq obj2break ent
brkobjlst (list ent)
enttype (cdr (assoc 0 (entget ent)))
)
(foreach brkpt brkptlst ; get last entity created via break
; in case multiple breaks
(if brkobjlst
(progn ; if pt not on object x, switch
; objects
(if (not (numberp (vl-catch-all-apply
'vlax-curve-getdistatpoint
(list obj2break brkpt)
)
)
)
(foreach obj brkobjlst ; find the one that pt is on
(if (numberp (vl-catch-all-apply
'vlax-curve-getdistatpoint
(list obj brkpt)
)
)
(setq obj2break obj) ; switch objects
)
)
)
)
)
(setq
obj (vlax-ename->vla-object obj2break)
deriv (vlax-curve-getfirstderiv obj (vlax-curve-getparamatpoint obj brkpt))
deriv (v-normal deriv)
deriv (mapcar '(lambda (e) (* e (/ *break-width* 2.0))) deriv)
)
(setq closedobj (vlax-curve-isclosed obj2break))
(command "._break"
obj2break
"_non"
(trans (mapcar '+ brkpt deriv) 0 1)
"_non"
(trans (mapcar '- brkpt deriv) 0 1)
)
(if (not closedobj) ; new object was created
(setq brkobjlst (cons (entlast) brkobjlst))
)
)
)
(defun c:tt (/ rt option)
(setvar "CMDECHO" 0)
(princ (strcat "\n图层顺序: \"" (strcatlayernames *layer-sequence*) "\""))
(while (/= "E" option)
(initget "L D S E")
(setq option
(getkword
"\n输入选项 [图层(L)/间距(D)/开始选择(S)] <退出>:"
)
)
(cond
((= "L" option)
(select-layer-sequence)
(princ (strcat "\n图层顺序: \"" (strcatlayernames *layer-sequence*) "\""))
)
((= "D" option)
(get-break-dist)
)
((= "S" option)
(setq rt (append-break-point
(select-curves)
*layer-sequence*
)
)
(command ".undo" "BE")
(foreach e rt
(break_obj (car e) (cdr e))
)
(command ".undo" "E")
(setq option "E")
)
((= nil option)
(setq option "E")
)
)
)
(setvar "CMDECHO" 1)
(princ)
)

(setq *layer-sequence* '("图层1" "图层2" "图层3" "图层4" "图层5" "图层6" "图层7") 
      *break-width*    200.0 
) 
 
(defun strcatlayernames        (layernames / a) 
  (setq        a           (car layernames) 
        layernames (cdr layernames) 
  ) 
 
  (while layernames 
    (setq a             (strcat a "," (car layernames)) 
          layernames (cdr layernames) 
    ) 
  ) 
  a 
) 
 
 
(defun select-layer-sequence (/ en rt) 
  (while (setq en (entsel "选择对象:")) 
    (setq rt (cons (cdr (assoc 8 (entget (car en)))) rt)) 
  ) 
  (setq *layer-sequence* (reverse rt)) 
) 
 
 
(defun get-break-dist (/ rt) 
  (setq        rt (getdist 
             (strcat "\n输入断开间距 <" (rtos *break-width* 2 2) ">: ") 
           ) 
  ) 
 
  (if (not (null rt)) 
    (setq *break-width* rt) 
  ) 
) 
 
 
(defun select-curves (/ ent i n rt ss) 
 
  (setq        ss (ssget (list        '(0 . "*LINE,ARC,CIRCLE,ELLIPSE") 
                        (cons 8 (strcatlayernames *layer-sequence*)) 
                  ) 
           ) 
        i  0 
        n  (sslength ss) 
  ) 
  (repeat n 
    (setq ent (ssname ss i) 
          rt  (cons (list ent 
                          (cdr (assoc 8 (entget ent))) 
                    ) 
                    rt 
              ) 
          i   (1+ i) 
    ) 
  ) 
 
  ;; (<图元名: -24a300> "图层2") 
  ;; ... 
  rt 
) 
 
 
(defun append-break-point (lst layerorder / ipts old pts rt) 
  (foreach e1 lst 
    (foreach e2        (cdr lst) 
 
      ;; 图层不打断 
      (if (< (vl-position (cadr e1) layerorder) (vl-position (cadr e2) layerorder)) 
        (progn 
          (setq        ipts (vlax-variant-value 
                       (vla-intersectwith 
                         (vlax-ename->vla-object (car e1)) 
                         (vlax-ename->vla-object (car e2)) 
                         0 
                       ) 
                     ) 
          ) 
 
          (if (> (vlax-safearray-get-u-bound ipts 1) 0) 
            (progn 
              (setq ipts (vlax-safearray->list ipts)) 
              (while ipts 
                (setq pts  (cons (list (car ipts) 
                                       (cadr ipts) 
                                       (caddr ipts) 
                                 ) 
                                 pts 
                           ) 
                      ipts (cdddr ipts) 
                ) 
              ) 
              (if (setq old (assoc (car e2) rt)) 
                (setq rt (subst (append old pts) old rt)) 
                (setq rt (cons (cons (car e2) pts) rt)) 
              ) 
              (setq pts nil) 
            ) 
          ) 
        ) 
      ) 
    ) 
  ) 
 
  ;; (<图元名: -2306e0> (-224414.0 66920.2 0.0) (-224414.0 65920.2 0.0)).. 
  ;; ... 
  rt 
) 
 
 
 
(defun v-length        (v /) 
  (sqrt (apply '+ (mapcar '(lambda (e) (* e e)) v))) 
) 
 
 
(defun v-normal        (v / len) 
  (setq len (v-length v)) 
  (if (/= 0 len) 
    (mapcar '(lambda (e) (/ e len)) v) 
    '(0.0 0.0 0.0) 
  ) 
) 
 
 
;;; Author: Copyright? 2006,2007 Charles Alan Butler 
;;; Contact @  <a rel=\"nofollow\" href=\"/plugin.php?id=laoyang_wailianx&url=http://www.TheSwamp.org\" target=\"_blank\">www.TheSwamp.org</a> 
(defun break_obj (ent brkptlst / brkobjlst closedobj deriv e enttype obj obj2break) 
  (setq        obj2break ent 
        brkobjlst (list ent) 
        enttype          (cdr (assoc 0 (entget ent))) 
  ) 
  (foreach brkpt brkptlst                ;  get last entity created via break 
                                        ; in case multiple breaks 
    (if        brkobjlst 
      (progn                                ;  if pt not on object x, switch 
                                        ; objects 
        (if (not (numberp (vl-catch-all-apply 
                            'vlax-curve-getdistatpoint 
                            (list obj2break brkpt) 
                          ) 
                 ) 
            ) 
          (foreach obj brkobjlst        ; find the one that pt is on 
            (if        (numberp (vl-catch-all-apply 
                           'vlax-curve-getdistatpoint 
                           (list obj brkpt) 
                         ) 
                ) 
              (setq obj2break obj)        ; switch objects 
            ) 
          ) 
        ) 
      ) 
    ) 
 
    (setq 
      obj   (vlax-ename->vla-object obj2break) 
      deriv (vlax-curve-getfirstderiv obj (vlax-curve-getparamatpoint obj brkpt)) 
      deriv (v-normal deriv) 
      deriv (mapcar '(lambda (e) (* e (/ *break-width* 2.0))) deriv) 
    ) 
 
 
    (setq closedobj (vlax-curve-isclosed obj2break)) 
    (command "._break" 
             obj2break 
             "_non" 
             (trans (mapcar '+ brkpt deriv) 0 1) 
             "_non" 
             (trans (mapcar '- brkpt deriv) 0 1) 
    ) 
    (if        (not closedobj)                        ; new object was created 
      (setq brkobjlst (cons (entlast) brkobjlst)) 
    ) 
  ) 
) 
 
 
(defun c:tt (/ rt option) 
  (setvar "CMDECHO" 0) 
 
  (princ (strcat "\n图层顺序: \"" (strcatlayernames *layer-sequence*) "\"")) 
  (while (/= "E" option) 
    (initget "L D S E") 
    (setq option 
           (getkword 
             "\n输入选项 [图层(L)/间距(D)/开始选择(S)] <退出>:" 
           ) 
    ) 
    (cond 
      ((= "L" option) 
       (select-layer-sequence) 
       (princ (strcat "\n图层顺序: \"" (strcatlayernames *layer-sequence*) "\"")) 
      ) 
      ((= "D" option) 
       (get-break-dist) 
      ) 
      ((= "S" option) 
       (setq rt        (append-break-point 
                  (select-curves) 
                  *layer-sequence* 
                ) 
       ) 
 
       (command ".undo" "BE") 
       (foreach        e rt 
         (break_obj (car e) (cdr e)) 
       ) 
       (command ".undo" "E") 
       (setq option "E") 
      ) 
      ((= nil option) 
       (setq option "E") 
      ) 
    ) 
  ) 
 
  (setvar "CMDECHO" 1) 
  (princ) 
)

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

[已解答] 急求按顺序打断线条的程序！！！

评分

本帖子中包含更多资源

点评

点评