修剪十字交叉线段

ooohen

可否也给我一个啊,谢谢,我的邮箱l.z.yang@163.com

zhl0123321

谢谢,我的邮箱zhl0123321@sohu.com

mjz521yy

楼上兄弟，我的邮箱zhaoyang521yy@126.com，也给我发一个吧……谢谢

AMTONNY

支持原创,支持共享,可否发原码上来共享呀

samshs

多謝！我的邮箱是： samshs@126.com

userzhl

为何不共享出来呢？

crab3

多謝

userzhl

可否也给我一个啊,谢谢！我的邮箱user-zhl@163.com

shenying123

兄弟也给我一个啊,谢谢,我的邮箱shenying_sy@163.comy@163.com

hdlyt11

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;ZML84制作于2006-12-07
;;;==========================================
;;;全局变量说明：
;;;EDGE_JL  外延距离
;;;==========================================
(defun c:tt (/ S0 S1 PT entl LX
     PT0 PT0_OLD PT1 PT1_OLD)
    (princ "\n★★超级修剪★★")

    (setq CMDECHO_OLD (getvar "CMDECHO")
    )
    (Setvar "CMDECHO" 0)

    (if (or (= EDGE_jl "") (= EDGE_jl nil))
(setq EDGE_jl 5.0)
    )
    (princ
(strcat "\n当前设置:投影="
(nth (getvar "PROJMODE") '("不投影" "当前UCS" "当前视图"))
"，边="
(nth (getvar "EDGEMODE") '("不延伸" "延伸"))
"，外延距离="
(rtos EDGE_JL 2 (getvar "LUPREC"))
)
    )

    (princ "\n选择剪切边...")
    (setq S0 (ssget))

    (if (= S0 nil)
(princ "\n★未选择边界，即将退出。")
(progn
    (setq S1 nil)
    (while (or (/= S1 nil)
       (/= nil
   (progn (initget 4 "P E D U")
  (setq pt (GETPOINT
       "\n选择要修剪的对象，或 [投影(P)/边(E)/外延距离(D)/放弃(U)]:"
   )
  )
   )
       )
   )

(cond
    ((= pt "P") ;分支一：投影选项设置
     (progn
(initget 4)
(SETQ
     XX (getint
    (strcat
"\n输入投影选项 [无(0)/UCS(1)/视图(2)] <"
(itoa (getvar "PROJMODE"))
">:"
    )
)
)
(if (or (= xx 0) (= xx 1) (= xx 2))
     (Setvar "PROJMODE" xx)
)
     )
    )

    ((= pt "E") ;分支二：边延伸选项设置
     (progn
(initget 4)
(SETQ XX (getint
      (strcat
  "\n输入隐含边延伸模式 [不延伸(0)/延伸(1)] <"
  (itoa (getvar "EDGEMODE"))
  ">:"
      )
  )
)
(if (or (= xx 0) (= xx 1))
     (Setvar "EDGEMODE" xx)
)
     )
    )

    ((= pt "D") ;分支三：外延距离选项设置
     (progn
(initget 4)
(SETQ XX (getdist
      (strcat
  "\n输入外延的距离 <"
  (rtos EDGE_jl
2
(getvar "LUPREC")
  )
  ">:"
      )
  )
)
(if (>= xx 0)
     (setq EDGE_jl xx)
)
     )
    )

    ((= pt "U") ;分支四：撤销上一步操作
     (command "_.undo" 1)
    )

    ((listp pt) ;分支五：对选中的对象进行修剪操作
     (if (ssget pt)
(progn
     (setq s1 (list (ssname (ssget pt) 0) pt))
     (setq entl (entget (car s1) '("*"))
   LX (dxf_let entl 0)
     )

     (cond ;对各种对象类型进行操作。
((= LX "LINE")
  (progn
      (command "_.undo" "be")
      (setq pt0_old (dxf_let entl 10)
    pt1_old (dxf_let entl 11)
      )
      (command "_trim" s0 "" s1 "")
      (setq entl (entget (car s1) '("*")))
      (setq pt0 (dxf_let entl 10)
    pt1 (dxf_let entl 11)
      )
      (if (and (equal pt0 pt0_old)
       (equal pt1 pt1_old)
  )
  (princ "\n★对象未与边相交。")
  (progn

      (if (not (equal pt0 pt0_old))
     ;检查起点
  (dxf_set
      entl
      10
      (polar pt0
     (angle pt0 pt0_old)
     EDGE_jl
      )
  )
  (if (not (equal pt1 pt1_old))
     ;检查终点
      (dxf_set
  entl
  11
  (polar pt1
(angle pt1
pt1_old
)
EDGE_jl
  )
      )
  )
      )
      (command "_.undo" "e")
  )
      )

  )
)
((= LX "ARC")
  (princ (strcat "\n★对象类型为\""
LX
"\"，暂不能处理。"
)
  )
)
(T
  (princ
      (strcat "\n★对象类型\""
      LX
      "\"，拒绝操作。"
      )
  )
)
     )
)
(princ "\n★未选择到对象。")
     )
    ) ;结束 分支五

) ;结束 cond 结束分支

(setq S1 nil)
    ) ;结束 while
)
    ) ;结束 if

    (Setvar "CMDECHO" CMDECHO_OLD)

    (princ "\n★正常结束。谢谢使用。")
    (princ)
);结束 defun

;;;定义函数，用于提取属性。
(defun dxf_let (ent n)
    (if (assoc n ent)
(cdr (assoc n ent))
nil
    )
);结束 defun

;;;定义函数，用于修改属性。
(defun dxf_set (ent n nr)
    (if (assoc n ent)
(progn
    (setq ent (subst (cons n nr) (assoc n ent) ent)
    )
    (entmod ent)
)
nil
    ) ;结束 if
);结束 defun

(princ "\n\n★超级修剪。键入命令\"TT\"执行。")
(princ)
http://xzd.2000y.net/mb/1/ReadNews.asp?NewsID=579606