5币求画线截断直线程序，要源码

半听可乐

理想功能：用鼠标指定两点，然后将鼠标两点之间的所有直线截断并删除断开的某边，删除方向可选
理想使用方法：1.鼠标左键指定两点   2.鼠标左键指定删除哪一边（类似于执行偏移命令时选择方向）

Gu_xl

半听可乐 发表于 2012-7-7 00:08
非常感谢！但还有bug：当截断多条线时有些线截断不了，还没找到规律性~~望好人继续完善

游客，本帖隐藏的内容需要发帖数高于 20 才可浏览，你当前发帖数只有 0

Andyhon

(defun C:/= ()
   (prompt "\n鼠标左键指定两点...")
   (setq p1 (getpoint "\n 1st 点: ")
         p2 (getpoint p1 "\n 2nd 点: ")
   )
   (cond
    ((setq ss (ssget "C" p1 p2))
     (setq p3 (getpoint "\n鼠标左键指定删除哪一边: ")
            i  0     
     )
     (while (setq ee (ssname ss i))
       (setq dat (entget ee)
              pa (cdr (assoc 10 dat))
              pb (cdr (assoc 11 dat))
              px (inters p1 p2 pa pb nil)
              pt (PerToLine p3 pa pb)   ; http://bbs.mjtd.com/thread-89548-1-1.html
               i (1+ i)
       )
       (cond
        ((equal (distance pa px) (+ (distance pa pt) (distance pt px)) 1e-4)
         (setq dp 10)
        )
        ((equal (distance pb px) (+ (distance pb pt) (distance pt px)) 1e-4)
         (setq dp 11)
        )
        ((equal (distance pt px) (+ (distance pt pa) (distance pa px)) 1e-4)
         (setq dp 10)
        )
        ((equal (distance pt px) (+ (distance pt pb) (distance pb px)) 1e-4)
         (setq dp 11)
       ))         
       (entmod (subst (cons dp px) (assoc dp dat) dat))
   )))
)
不合需求时请上传调试用 Dwg 文件

hao3ren

(defun c:jd()
(setq pt1 (getpoint "/n指定第1点："))
(setq pt2 (getpoint "/n指定第2点："))
(setq pt3 (getpoint "/n指定第3点："))
(command "line" pt1 pt2 "")
(setq tg (entLast))
(command "trim" tg "" "f" pt1 pt3 pt2 "" "")
(entdel tg)
)

hao3ren

Andyhon ，子函数PERTOLINE补充一下码

半听可乐

Andyhon 发表于 2012-7-6 16:57
不合需求时请上传调试用 Dwg 文件

CAD2004提醒：错误: no function definition: PERTOLINE

xiaxiang

好像类似于画线剪切。。。

Andyhon

半听可乐 发表于 2012-7-6 17:16
CAD2004提醒：错误: no function definition: PERTOLINE

(PerToLine p3 pa pb)   ; http://bbs.mjtd.com/thread-89548-1-1.html
PerToLine 在 http://bbs.mjtd.com/thread-89548-1-1.html

半听可乐

hao3ren 发表于 2012-7-6 17:11
(defun c:jd()
(setq pt1 (getpoint "/n指定第1点："))
(setq pt2 (getpoint "/n指定第2点："))

功能很接近了，美中不足的是指定前面两点时没有两点间的预览线（截断前的预览，配合正交开关能把直线截得横平竖直^_^   下图演示中我指的“预览线”比较明显），希望朋友能改进一下

hao3ren

(defun c:jd()
(setq pt1 (getpoint "\n指定第1点："))
(setq pt2 (getpoint pt1 "\n指定第2点："))
(setq pt3 (getpoint "\n指定第3点："))
(command "line" pt1 pt2 "")
(setq tg (entLast))
(command "trim" tg "" "f" pt1 pt3 pt2 "" "")
(entdel tg)
)