社区 › AutoLISP/Visual LISP 编程技术 › 这个怎么实现

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 static/image/common/back.gif


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

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 static/image/common/back.gif


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

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

xyp1964 发表于 2013-8-28 12:41 static/image/common/back.gif


你的好像不能用 哪里错了

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

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

fjutcivil 发表于 2013-8-27 21:35 http://bbs.mjtd.com/static/image/common/back.gif
就是附件那张图纸里面左图达到右图的效果就可以了

应该是你要的，没加出错和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
            )
          )
    )
)
)

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

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

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

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

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

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

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

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

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

查看完整版本: 这个怎么实现