这个怎么实现

xyp1964 · 发表于 2013-8-28 12:28:52

本帖最后由 xyp1964 于 2013-8-28 12:45 编辑

;; 多段线端点打断
(defun c:tt (/ i ss s1 pt) (CMDLA0) (setq i -1) (if (setq ss (ssget '((0 . "*polyLINE")))) (while (setq s1 (ssname ss (setq i (1+ i)))) (setq ptn (xyp-get-Vertexs s1 3) ptn (cdr ptn) ptn (reverse ptn) ptn (cdr ptn) ) (foreach pt ptn (xyp-breake s1 pt pt) ) ) ) (CMDLA1))

nzl1116 · 发表于 2013-8-28 12:33:00

xyp1964 发表于 2013-8-28 12:28

看来版主是没理会楼主的意思

xyp1964 · 发表于 2013-8-28 12:41:26

本帖最后由 xyp1964 于 2013-8-28 12:44 编辑

;; 多段线交点打断
(defun c:tt ()
(CMDLA0)
(setq i -1)
(if (setq ss (ssget '((0 . "*polyLINE"))))
(while (setq s1 (ssname ss (setq i (1+ i))))
(if (setq ptn (xyp-Get-CurveIntersLengLay s1 3 "DOTE"))
(foreach pt (reverse ptn)
(xyp-breake s1 pt pt)
)
)
)
)
(CMDLA1)
)

nzl1116 · 发表于 2013-8-28 12:52:49

xyp1964 发表于 2013-8-28 12:41

楼主的意思是打断被压在粗线下面的细实线，我一开始也没看懂，只是楼主在晓东发的帖子说的更容易让人理解罢了。

fjutcivil · 发表于 2013-8-28 14:19:16

xyp1964 发表于 2013-8-28 12:41

你的好像不能用哪里错了

ll_j · 发表于 2013-8-28 15:25:32

本帖最后由 ll_j 于 2013-8-29 11:11 编辑

fjutcivil 发表于 2013-8-27 21:35
就是附件那张图纸里面左图达到右图的效果就可以了

应该是你要的，没加出错和undo处理，你自己再看看。

(defun c:tt (/ ss dt pl i en e el)
(setq ss (ssget '((0 . "*LINE") (8 . "a,DOTE"))) ;选择，图层a和DOTE应根据实际修改
i -1
dt nil
pl nil
)
(repeat (sslength ss)
(setq i (1+ i))
(if (and (= (cdr (assoc 8 (entget (setq en (ssname ss i))))) "a") ;分离墙线，图层a
(= (cdr (assoc 0 (entget en))) "LWPOLYLINE") ;线形多段线
)
(setq pl (cons en pl)) ;多段线
(setq dt (cons en dt)) ;轴线
)
)
(setq dt (ll dt '(10 11)) ;构造图元名+端点的轴线表
pl (ll pl '(10)) ;构造图元名+顶点的墙线表
el (entlast) ;最后实体，备用
)
(mapcar ;打断多段线
'(lambda (x)
(if (> (length x) 3)
(progn
(setq e (list (car x) (cadr x)))
(mapcar
'(lambda (y)
(command ".break" e "f" y y)
)
(cdr (reverse (cdr x)))
)
)
)
)
pl
)
(while (setq e (entnext el)) ;重新构造多段线表
(setq pl (cons (list e) pl)
el e
)
)
(setq pl (mapcar 'car pl) ;只保留多段线图元名
pl (mapcar 'cdr (ll pl '(10))) ;只保留多段线顶点
pl (apply 'append pl) ;顶点汇总
)
(setq dt (mapcar ;构造轴线相互交叉点表，图元名+起点+端点+交叉点...
'(lambda (x)
(setq tl nil)
(mapcar
'(lambda (y)
(if (setq
it (inters (cadr x) (caddr x) (cadr y) (caddr y))
)
(setq tl (cons it tl))
)
)
dt
)
(if tl
(append x tl)
x
)
)
dt
)
dt (mapcar ;添加多段线在轴线上的顶点
'(lambda (x)
(setq tl nil)
(mapcar
'(lambda (y)
(if (equal (+ (distance y (cadr x))
(distance y (caddr x))
)
(distance (cadr x) (caddr x))
1e-6
)
(setq tl (cons (append y '(0.0)) tl))
)
)
pl
)
(if tl
(append x tl)
x
)
)
dt
)
dt (mapcar ;特征点排序，除重
'(lambda (x)
(append
(list (car x) (cadr x))
(su (vl-sort
(cddr x)
'(lambda (y z)
(> (distance (cadr x) y) (distance (cadr x) z))
)
)
)
)
)
dt
)
)
(mapcar ;打断
'(lambda (x)
(setq e (list (car x) (cadr x)))
(mapcar
'(lambda (y)
(command ".break" e "f" y y)
)
(cddr x)
)
)
dt
)
(princ)
)
(defun ll (l nl) ;提取点表
(mapcar
'(lambda (x)
(cons x
(mapcar 'cdr
(vl-remove-if-not
'(lambda (y) (member (car y) nl))
(entget x)
)
)
)
)
l
)
)
(defun su (l) ;点表除重
(if l
(cons (car l)
(su (vl-remove-if
'(lambda (x) (equal (distance (car l) x) 0 1e-6))
l
)
)
)
)
)

(defun c:tt (/ ss dt pl i en e el) 
  (setq ss (ssget '((0 . "*LINE") (8 . "a,DOTE")))    ;选择，图层a和DOTE应根据实际修改 
        i  -1 
        dt nil 
        pl nil 
  ) 
  (repeat (sslength ss) 
    (setq i (1+ i)) 
    (if (and (= (cdr (assoc 8 (entget (setq en (ssname ss i))))) "a")   ;分离墙线，图层a 
             (= (cdr (assoc 0 (entget en))) "LWPOLYLINE")  ;线形多段线 
        ) 
      (setq pl (cons en pl))  ;多段线 
      (setq dt (cons en dt))  ;轴线 
    ) 
  ) 
  (setq dt (ll dt '(10 11))   ;构造图元名+端点的轴线表 
        pl (ll pl '(10))  ;构造图元名+顶点的墙线表 
        el (entlast)   ;最后实体，备用 
  ) 
  (mapcar    ;打断多段线 
    '(lambda (x) 
       (if (> (length x) 3) 
         (progn 
           (setq e (list (car x) (cadr x))) 
           (mapcar 
             '(lambda (y) 
                (command ".break" e "f" y y) 
              ) 
             (cdr (reverse (cdr x))) 
           ) 
         ) 
       ) 
     ) 
    pl 
  ) 
  (while (setq e (entnext el))     ;重新构造多段线表 
    (setq pl (cons (list e) pl) 
          el e 
    ) 
  ) 
  (setq pl (mapcar 'car pl)     ;只保留多段线图元名 
        pl (mapcar 'cdr (ll pl '(10))) ;只保留多段线顶点 
        pl (apply 'append pl)   ;顶点汇总 
  ) 
  (setq dt (mapcar    ;构造轴线相互交叉点表，图元名+起点+端点+交叉点... 
             '(lambda (x) 
                (setq tl nil) 
                (mapcar 
                  '(lambda (y) 
                     (if (setq 
                           it (inters (cadr x) (caddr x) (cadr y) (caddr y)) 
                         ) 
                       (setq tl (cons it tl)) 
                     ) 
                   ) 
                  dt 
                ) 
                (if tl 
                  (append x tl) 
                  x 
                ) 
              ) 
             dt 
           ) 
        dt (mapcar  ;添加多段线在轴线上的顶点 
             '(lambda (x) 
                (setq tl nil) 
                (mapcar 
                  '(lambda (y) 
                     (if (equal (+ (distance y (cadr x)) 
                                   (distance y (caddr x)) 
                                ) 
                                (distance (cadr x) (caddr x)) 
                                1e-6 
                         ) 
                       (setq tl (cons (append y '(0.0)) tl)) 
                     ) 
                   ) 
                  pl 
                ) 
                (if tl 
                  (append x tl) 
                  x 
                ) 
              ) 
             dt 
           ) 
        dt (mapcar     ;特征点排序，除重 
             '(lambda (x) 
                (append 
                  (list (car x) (cadr x)) 
                  (su (vl-sort 
                        (cddr x) 
                        '(lambda (y z) 
                           (> (distance (cadr x) y) (distance (cadr x) z)) 
                         ) 
                      ) 
                  ) 
                ) 
              ) 
             dt 
           ) 
  ) 
  (mapcar         ;打断 
    '(lambda (x) 
       (setq e (list (car x) (cadr x))) 
       (mapcar 
         '(lambda (y) 
            (command ".break" e "f" y y) 
          ) 
         (cddr x) 
       ) 
     ) 
    dt 
  ) 
  (princ) 
) 
 
 
(defun ll (l nl)   ;提取点表 
  (mapcar 
    '(lambda (x) 
       (cons x 
             (mapcar 'cdr 
                     (vl-remove-if-not 
                       '(lambda (y) (member (car y) nl)) 
                       (entget x) 
                     ) 
             ) 
       ) 
     ) 
    l 
  ) 
) 
 
(defun su (l)   ;点表除重 
  (if l 
    (cons (car l) 
          (su (vl-remove-if 
                '(lambda (x) (equal (distance (car l) x) 0 1e-6)) 
                l 
              ) 
          ) 
    ) 
  ) 
)

fjutcivil · 发表于 2013-8-29 10:07:24

ll_j 发表于 2013-8-28 15:25
应该是你要的，没加出错和undo处理，你自己再看看。

额我这边怎么运行不了你写的，是不是哪里出错了？还有晓东那边有人回了我个my_wipeout的代码那个怎么加载呢，前面要写什么？

ll_j · 发表于 2013-8-29 11:15:54

fjutcivil 发表于 2013-8-29 10:07
额我这边怎么运行不了你写的，是不是哪里出错了？还有晓东那边有人回了我个my_wipeout的代码那个怎么加 ...

是我在最前面声明局部变量的时候漏了一个空格，现在改好了。开始写的时候没有声明局部变量，复制粘贴后又增加了声明，结果不小心在/和ss之间漏了一个空格。

fjutcivil · 发表于 2014-3-29 20:29:29

ll_j 发表于 2013-8-27 11:14
不是一个专业，不太看懂“PL端点处打断轴线”的意思，可以看看break命令的F选项是否有用。
右面“掏空”的 ...

那个掏空功能还是没找到啊貌似是消除残影那个可是没有币！囧

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

[提问] 这个怎么实现

本帖子中包含更多资源

点评

本帖子中包含更多资源

点评

评分

浏览过的版块