[LISP程序]：求画线修剪的LISP

quanleilei

哪位高手能编写或上传一个画线修剪的LISP文件,,感觉很有用,谢谢啦

gysjy

请叙说一下画线修剪的具体要求。

quanleilei

就是那种在直线需要修剪的地方左右各点击一下,然后再选择想要修剪掉的一侧,即可将直线该侧剪切掉的那种LISP
我的邮箱是quanlei888@126.com,哪位高手能不能直接发到我的邮箱里,十分感谢!!!

carrot1983

最初由 quanleilei 发布
[B]就是那种在直线需要修剪的地方左右各点击一下,然后再选择想要修剪掉的一侧,即可将直线该侧剪切掉的那种LISP
我的邮箱是quanlei888@126.com,哪位高手能不能直接发到我的邮箱里,十分感谢!!! [/B]

安装CAD的express tool ，运行extrim命令就可以实现

quanleilei

楼上的哥们,谢谢你的答复!
但是我的意思是说,打个比方:有一条直线,我想修剪它,我就直接在该直线的两边各点一点,然后就直接把要修剪的直线在（我点的两点所连成的线）与（要修剪的直线）的交点处将想剪切的一侧剪切掉。

gysjy

最初由 quanleilei 发布
[B]我的意思是说,打个比方:有一条直线,我想修剪它,我就直接在该直线的两边各点一点,然后就直接把要修剪的直线在（我点的两点所连成的线）与（要修剪的直线）的交点处将想剪切的一侧剪切?.. [/B]

看看下面的程序是否适合你：

2. 
   
3.   [FONT=courier new]
   
4. (defun to(n)
   
5.   (cdr (assoc n (entget sn)))
   
6. )
   
7. (princ "\n界线剪切，命令名: qtrim。GYSJY, 2008.12.6")
   
8. (defun c:qtrim(/ sn p0 p1 p2 s1 s2 lst)
   
9.   (command "undo" "g")  
   
10.   (setvar "cmdecho" 0)
    
11.   (setvar "osmode" 0)   
    
12.   (graphscr)
    
13.   (setq p1 (getpoint "\n第一点:") p2 (getpoint "\n第二点:" p1)
    
14.         p0 (getpoint "\n点取你想要修剪的那一侧:")
    
15.   )
    
16.   (command "line" p1 p2 "")
    
17.   (setq s1 (entlast))
    
18.   (command "offset" "1" s1 p0 "")
    
19.   (setq sn (entlast))
    
20.   (setq p1 (to 10) p2 (to 11) lst (list p1 p2))
    
21.   (command "trim" s1 "" "f" p1 p2 "" "")
    
22.   (if (setq s2 (ssget "f" lst))(command "erase" s2 ""))
    
23.   (command "erase" s1 "")
    
24.   (command "undo" "e")
    
25.   (princ)
    
26. )
    
27.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun to(n)<br />   (cdr (assoc n (entget sn)))<br /> )<br /> (princ "\n界线剪切，命令名: qtrim。GYSJY, 2008.12.6") <br /> (defun c:qtrim(/ sn p0 p1 p2 s1 s2 lst)<br />   (command "undo" "g")  <br />   (setvar "cmdecho" 0) <br />   (setvar "osmode" 0)   <br />   (graphscr)<br />   (setq p1 (getpoint "\n第一点:") p2 (getpoint "\n第二点:" p1)<br />         p0 (getpoint "\n点取你想要修剪的那一侧:")<br />   )<br />   (command "line" p1 p2 "")<br />   (setq s1 (entlast))<br />   (command "offset" "1" s1 p0 "") <br />   (setq sn (entlast))<br />   (setq p1 (to 10) p2 (to 11) lst (list p1 p2))<br />   (command "trim" s1 "" "f" p1 p2 "" "")<br />   (if (setq s2 (ssget "f" lst))(command "erase" s2 ""))<br />   (command "erase" s1 "")<br />   (command "undo" "e")<br />   (princ)<br /> )<br />   [/FONT]<br />

carrot1983

不错。。。
提出几个建议：
1.不要把人家的系统变量改了。特别osmode
2.用command 最好是用临时关闭捕捉的用法在点前面加"none"
3.那条剪切线最好是先画来，再决定要剪切哪侧。

gysjy

最初由 carrot1983 发布
[B]提出几个建议：
1.不要把人家的系统变量改了。特别osmode
2.用command 最好是用临时关闭捕捉的用法在点前面加"none"
3.那条剪切线最好是先画来，再决定要剪切哪侧。 [/B]

所提建议很好。下面是修改后的程序：

2. 
   
3.   [FONT=courier new]
   
4. (defun to(n)
   
5.   (cdr (assoc n (entget sn)))
   
6. )
   
7. 
   
8. (princ "\n界线剪切，命令名: qtrim。GYSJY, 2008.12.7")
   
9. (defun c:qtrim( / cm lst os p0 p1 p2 s1 s2 sn)
   
10.   (command "undo" "g")  
    
11.   (setq os (getvar "osmode") cm (getvar "cmdecho"))
    
12.   (setvar "cmdecho" 0)
    
13.   (setvar "osmode" 0)   
    
14.   (graphscr)
    
15.   (setq p1 (getpoint "\n第一点:") p2 (getpoint "\n第二点:" p1))
    
16.   (command "line" p1 p2 "")
    
17.   (setq s1 (entlast) p0 (getpoint "\n点取你想要修剪的那一侧:"))
    
18.   (if p0
    
19.     (progn
    
20.       (command "offset" "1" s1 p0 "")
    
21.       (setq sn (entlast))
    
22.       (setq p1 (to 10) p2 (to 11) lst (list p1 p2))
    
23.       (command "trim" s1 "" "f" p1 p2 "" "")
    
24.       (if (setq s2 (ssget "f" lst))(command "erase" s2 ""))
    
25.     )
    
26.   )
    
27.   (command "erase" s1 "")
    
28.   (setvar "cmdecho" cm)
    
29.   (setvar "osmode" os)  
    
30.   (command "undo" "e")
    
31.   (princ)
    
32. )
    
33. 
    
34. 
    
35.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun to(n)<br />   (cdr (assoc n (entget sn)))<br /> )<br /> <br /> (princ "\n界线剪切，命令名: qtrim。GYSJY, 2008.12.7") <br /> (defun c:qtrim( / cm lst os p0 p1 p2 s1 s2 sn)<br />   (command "undo" "g")  <br />   (setq os (getvar "osmode") cm (getvar "cmdecho"))<br />   (setvar "cmdecho" 0) <br />   (setvar "osmode" 0)   <br />   (graphscr)<br />   (setq p1 (getpoint "\n第一点:") p2 (getpoint "\n第二点:" p1))<br />   (command "line" p1 p2 "")<br />   (setq s1 (entlast) p0 (getpoint "\n点取你想要修剪的那一侧:"))<br />   (if p0 <br />     (progn<br />       (command "offset" "1" s1 p0 "") <br />       (setq sn (entlast))<br />       (setq p1 (to 10) p2 (to 11) lst (list p1 p2))<br />       (command "trim" s1 "" "f" p1 p2 "" "")<br />       (if (setq s2 (ssget "f" lst))(command "erase" s2 ""))<br />     )<br />   )<br />   (command "erase" s1 "")<br />   (setvar "cmdecho" cm) <br />   (setvar "osmode" os)  <br />   (command "undo" "e")<br />   (princ)<br /> )<br /> <br /> <br />   [/FONT]<br />

ctclsc

最初由 carrot1983 发布
[B][QUOTE]最初由 quanleilei 发布
[B]就是那种在直线需要修剪的地方左右各点击一下,然后再选择想要修剪掉的一侧,即可将直线该侧剪切掉的那种LISP
我的邮箱是quanlei888@126.com,哪位高手能不能直接发到我的邮... [/B]

zhongyang730

看起来不错，下来试试，谢了