Rocky121209 发表于 2016-7-8 12:03:36

请帮忙修改一下原有的代码

本帖最后由 Rocky121209 于 2016-7-9 09:00 编辑

(defun C:tt ( / edge ep i int line linename liness sp)
(vl-load-com)
(while (not edge)
    (setq edge (car (entsel "\n 请选择边界线:")))
    (redraw edge 3)
)
(prompt "\n 请选择需要延伸或者剪切的直线段: ")
(if (setq i 0
            liness (ssget '((0 . "LINE")))
      )
    (repeat (sslength liness)
      (setq line (entget (ssname liness i))
            sp (cdr (assoc 10 line))
            ep (cdr (assoc 11 line))
      )
      (if (setq int (nth 0 (x_intlst edge (ssname liness i) acExtendOtherEntity)))
      (if (< (distance int sp) (distance int ep))
          (entmod (subst (cons 10 int)(assoc 10 line) line))
          (entmod (subst (cons 11 int) (assoc 11 line)line))
      )
      )
      (setq i (1+ i))
    )
    (princ "\n 没有找到需要被延伸或者剪切的直线段")
)
(redraw edge 4)
)

(defun x_intlst (obj1 obj2 param / intlst1 intlst2 ptlst)
(if (= 'ENAME (type obj1))
    (setq obj1 (vlax-ename->vla-object obj1))
)
(if (= 'ENAME (type obj2))
    (setq obj2 (vlax-ename->vla-object obj2))
)
(setq intlst1 (vlax-variant-value (vla-intersectwith obj1 obj2 param)))
(if (< 0 (vlax-safearray-get-u-bound intlst1 1))
    (progn
      (setq intlst2 (vlax-safearray->list intlst1))
      (while (> (length intlst2) 0)
      (setq ptlst (cons (list (car intlst2) (cadr intlst2) (caddr intlst2))
                        ptlst
                  )
            intlst2 (cdddr intlst2)
      )
      )
    )
)
ptlst
)
(princ)
这段代码的作用如下：


求帮忙一下，想运行后变成这样





Rocky121209 发表于 2016-7-8 14:49:45

我好像弄错了方向，我是不是应该用TRIM比较容易达到我的要求？

Rocky121209 发表于 2016-7-9 09:00:36

额，没人愿意帮帮我么

Andyhon 发表于 2016-7-9 10:59:23

若能上传程序运行前及完成后的文件 (*.Dwg) 作为参考更能确定代码...

xymxydt 发表于 2016-7-9 12:53:17

看不太懂，或者说根本看不懂

Rocky121209 发表于 2016-7-9 14:36:41

本帖最后由 Rocky121209 于 2016-7-9 14:45 编辑

Andyhon 发表于 2016-7-9 10:59 static/image/common/back.gif
若能上传程序运行前及完成后的文件 (*.Dwg) 作为参考更能确定代码...


这个是一楼的代码执行效果，我想求大神帮忙修改一下，让最后结果变成

Rocky121209 发表于 2016-7-10 09:54:03

木有人能帮帮忙么。。。
页: [1]
查看完整版本: 请帮忙修改一下原有的代码