[LISP程序]：绘制截断线的程序，请大家一起来完善！

walong

绘制截断线的程序，请大家一起来完善！
;测试打断图元的效果
;程序：王龙
;时间：2004年元月
;打断分析：通常一张图纸中有多个图形，而打断一个图元，与这个图元相联的其它图元也应随之向内移。
;所以这个小程序的难点就在于，如何很好的作到，相联图元移动，其它无关图元不能移动（如图纸框线）
;我通过建立多个图层，将不移动的图元放在某些图层上，并将这些图层锁定。
;我感觉这样来移动图元和控制某些图元不能称动的方法很被动，这样对建图时，就要很好控制好图层，否则肯定会出问题。
;以下代码没有对图层进行锁定控制。
(defun c:dd();pz py pd p1 p2 p3 p4 pa pb tg pt pt0 pt1 pt2
  ;(command "layer" "m" "a1" "")
  ;(command "layer" "m" "a2" "")
  ;(command "layer" "m" "a3" "")
  ;(command "layer" "m" "a4" "")
  ;(command "layer" "m" "a5" "")
  ;(command "layer" "m" "a6" "")
  (setvar "cmdecho" 0)
  (setq os (getvar "osmode"))   ;获取对像捕捉原设定值
  (setvar "osmode" 0) ;关闭对像捕足

  ;按矩形进行修剪要打断的图元
  (PrinC "\n清除指定的矩形区...")
       (SetQ pz (GetPoint "\n左下角点: ") x0 (Car pz) y0 (Cadr pz)
             py (GetCorner pz "\n右上角点: ") x1 (Car py) y1 (Cadr py)
      pd (* 0.005 (Distance pz py))
      pww (- x1 x0)
       )
       ;(Command "zoom" "w" pz py)
       (SetQ p1 (List (+ x0 pd) (+ y0 pd))
             p2 (List (- x1 pd) (+ y0 pd))
             p3 (List (- x1 pd) (- y1 pd))
             p4 (List (+ x0 pd) (- y1 pd)) ;修剪用的围栏点
       )
       (SetQ pa (List (+ x0 pd pd) (+ y0 pd pd))
      pb (List (- x1 pd pd) (- y1 pd pd))
       )
       (Command "rectang" "f" 0 pz py) ;生成剪切边界框
       (SetQ tg (EntLast)) ;取出边界框对名
       (PrinC "\n开始")
       (SetVar "cmdecho" 0)
       (While (SSGet "c" pa pb) ;如果区域内还有图线...
         ;(setq ment (entget (ssname (SSGet "c" pa pb) 0)));为打断线提供点坐标作准备
  (Command "trim" tg "" "f" p1 p2 ""
                      "f" p2 p1 ""
                      "f" p2 p3 ""
                      "f" p3 p2 ""
                      "f" p3 p4 ""
                      "f" p4 p3 ""
                      "f" p4 p1 ""
                      "f" p1 p4 ""
                   ""  ;剪切
       )
       (EntDel tg)
       (Command "erase" "w" pz py "") ;删除中间的西
         ;(setq my0 (cadr (cdr (nth 18 ment))))
  ;(setq my1 (cadr (cdr (nth 22 ment))))
  ;(setq ml1 (list x0 (+ my0 10)));为画截断线找点
  ;(setq ml2 (list x0 (- my1 10)))
  ;(setq mr1 (list x1 (+ my0 10)))
  ;(setq mr2 (list x1 (- my1 10)))
  
  (setq ml1 (list x0 y0 ));为画截断线找点
  (setq ml2 (list x0 y1 ))
  (setq mr1 (list x1 y0 ))
  (setq mr2 (list x1 y1 ))
  
  (command "color" "r")
  (command "linetype" "s" "PHANTOM2" "")
  (command "line" ml1 ml2 "")
  (command "line" mr1 mr2 "")
  (command "linetype" "s" "byl" "")
  (command "color" "byl")
  ;绘制出的截断线长度与开始画的矩形修剪框有关，如果矩形修剪框画的上下不对，
  ;截断线也会上下不对称，显得不好看，不知如何解决
  (PrinC ".")
       )
       (PrinC " 完成.")(SetVar "cmdecho" 1) (PrinC)
  
  ;以点为界分左右两边进行划分选集
  ;(setq pt (getpoint "\n选分界点:"))
  (setq pt pa)
  (setq pt0 (list (car pt) -1e99 0))
  (setq pt1 '(-1e99 1e99 0))
  (setq pt2 '(1e99 1e99 0))
  (command ".zoom" "all")
  (setq ss1 (ssget "w" pt0 pt1)
ss2 (ssget "w" pt0 pt2))
  (command ".zoom" "p")
  ;(princ (strcat "左边有实体:" (itoa (sslength ss1)) "个,右边有实体:"(itoa (sslength ss2)) "个."))
  
  ;对图元进行移动
  (setq movepw (- pww 10))
  (command "move" ss1 "" '(0 0) (list movepw 0))
  (setvar "osmode" os) ;还原对像捕足

  (prin1)  
  )

陌生人

哦，想起来了，你是那个问中点左右选实体选择集的

walong

对！
这是为了选择，感谢你的帮助！

cy956

智能化程度要求太高了，不觉得机器傻，
觉得自己傻了。
光move是不够地，可能还有dim，
拉动之后dim数值还得保留，
还得画破折线，是圆管还
要画圆管的折断。。。。
嘿嘿！

walong

????????
我很想完善这个程序，我觉得这个程序很有用，不过我的能力有限，程序还有很缺陷。

841594

提一点思路：
这个程序的想法很好，问题在于怎样控制要移动和不要移动的实体。用锁定层的办法不够直接，有点费力不讨好：）。其实只需在执行的步骤中先加上选择要操作的实体的一步，以后的打断、移动都针对选择集内的实体进行，就可以了。
程序太自动化不一定是好事，如果增加了别的限制条件，带来的麻烦可能会把自动化的好处抵销掉。因此，在这里增加一步操作，换来的是实用性。

walong

最初由 841594 发布
[B]提一点思路：
这个程序的想法很好，问题在于怎样控制要移动和不要移动的实体。用锁定层的办法不够直接，有点费力不讨好：）。其实只需在执行的步骤中先加上选择要操作的实体的一步，以后的打断、移动都针对选择集内... [/B]

说的很好，我也是身有体会，所以才请大家来完善。
我现在的程序正是如上所说的缺陷！

coco25825

还是比较麻烦，程序太长了