[LISP程序]：试贴-一个小程序(关于修剪)

wkai

一个小程序，有用的话可以试试,修剪小东西时有用~
(defun c:tc(/ p1 p2 e)
(setq p1 (getpoint))
(setq p2 (getcorner p1))
(command "zoom" "w" p1 p2)
(command "trim" "c" p1 p2 "")
(while (setq e (entsel))
(command e)
)
(command)
(command "zoom" "p")
)

f5612140

鼓勵鼓勵,從基礎開始
(setq p1 (getpoint "\nFirst corner"))
...
比較明確

WRHCHINA

解释一下好吗？

talkershadows

这个lsp干什么用啊？？

r8899

对呀 解释一下吧

wkai

这是给同学介绍lisp时写的小程序，它是自带放大（zoom）的裁剪（trim）命令,裁剪完后自动恢复原来的视窗。

陌生人

关于交点打断的思路各位大侠是如何考虑的?
偶想了一下
可以这样:
1.框选范围内,求实体交点, >>成表 intlist
2.交点处打断所有实体
3.判断新生成的物体.如果长度小于某范围数值,删除

coolzhb

最初由 陌生人 发布
[B]关于交点打断的思路各位大侠是如何考虑的?
偶想了一下
可以这样:
1.框选范围内,求实体交点, >>成表 intlist
2.交点处打断所有实体
3.判断新生成的物体.如果长度小于某范围数值,删除 [/B]

想法不错，不知道实现方便否？还有就是图素很多时，执行的效率如何？

f5612140

讓我來拋磚引玉吧,之前貼了一個vba的,蒙版主不棄送了10個愛心幣,不好意思再拿出來騙錢
貼一個lisp的看看如何

2. 
   
3. (defun c:llt()
   
4. 
   
5.     (setvar "cmdecho" 0)
   
6.     (setq selnum (getvar "osmode"))
   
7.     (setvar "osmode" 0)
   
8.     (setq cly (getvar "clayer"))
   
9.     (setq tb (tblsearch "LAYER" "ZTEMP"))
   
10.     (if (= tb nil)(command "layer" "m" "ZTEMP" "c" 7 "ZTEMP" ""))
    
11.     (setq tb (tblsearch "LAYER" "ZZTEMP"))
    
12.     (if (= tb nil)(command "layer" "m" "ZZTEMP" "c" 7 "ZZTEMP" ""))
    
13. 
    
14. 
    
15.     (setq p1 (getpoint "\nFirst corner:"))
    
16.     (setq p2 (getcorner p1 "\nSecond corner:"))
    
17. 
    
18.     (setq ss (ssget "c" p1 p2 '((0 . "LINE"))))
    
19.     (setq ename (ssname ss 0))
    
20.     (setq endata (entget ename))
    
21.     (setq oldlay (cdr (assoc 8 endata)))
    
22.     (command "chprop" ss "" "la" "ZTEMP" "")
    
23. 
    
24. (if (= (sslength ss) 4)
    
25.   (progn   
    
26.     (setq i 0)
    
27.     (repeat (sslength ss)
    
28. 
    
29.       (setq ename (ssname ss i))
    
30.       (command "chprop" ename "" "la" "ZZTEMP" "")   
    
31.       (setq endata (entget ename))
    
32.       (setq pt1 (cdr (assoc 10 endata)))
    
33.       (setq pt2 (cdr (assoc 11 endata)))
    
34.       
    
35.       (setq ppf (list pt1 pt2))
    
36.       (setq ssk (ssget "F" ppf))
    
37.       (setq ssp (ssget "P" '((8 . "ZTEMP"))))
    
38. ;(print (sslength SSP))
    
39.         (if (= (sslength ssp) 2)
    
40.             (progn      
    
41.                  (setq enamel (ssname ssp 0))
    
42.                  (setq endata (entget enamel))
    
43.                  (setq ptr11 (cdr (assoc 10 endata)))
    
44.                  (setq ptr12 (cdr (assoc 11 endata)))
    
45.                  (setq ptrim1 (inters pt1 pt2 ptr11 ptr12 nil))
    
46.                  (setq enamel (ssname ssp 1))
    
47.                  (setq endata (entget enamel))
    
48.                  (setq ptr21 (cdr (assoc 10 endata)))
    
49.                  (setq ptr22 (cdr (assoc 11 endata)))
    
50.                  (setq ptrim2 (inters pt1 pt2 ptr21 ptr22 nil))
    
51.            (command "break" ename ptrim1 ptrim2)
    
52.            (setq ssz (ssget "X" '((8 . "ZZTEMP"))))
    
53.            (command "chprop" ssz "" "la" "ZTEMP" "")
    
54.              )   
    
55.         )   
    
56. 
    
57.       (setq i (+ i 1))
    
58.       
    
59.     )
    
60.       
    
61.   )  
    
62. )
    
63.     (setq ssz (ssget "X" '((8 . "ZTEMP"))))
    
64.     (command "chprop" ssz "" "la" oldlay "")
    
65.     (setvar "osmode" selnum)
    
66.     (setvar "clayer" cly)
    
67. (prin1)
    
68. )
    
69. (prin1)
    

<br /> (defun c:llt()<br /> <br />     (setvar "cmdecho" 0)<br />     (setq selnum (getvar "osmode"))<br />     (setvar "osmode" 0)<br />     (setq cly (getvar "clayer"))<br />     (setq tb (tblsearch "LAYER" "ZTEMP"))<br />     (if (= tb nil)(command "layer" "m" "ZTEMP" "c" 7 "ZTEMP" ""))<br />     (setq tb (tblsearch "LAYER" "ZZTEMP"))<br />     (if (= tb nil)(command "layer" "m" "ZZTEMP" "c" 7 "ZZTEMP" ""))<br /> <br /> <br />     (setq p1 (getpoint "\nFirst corner:"))<br />     (setq p2 (getcorner p1 "\nSecond corner:"))<br /> <br />     (setq ss (ssget "c" p1 p2 '((0 . "LINE"))))<br />     (setq ename (ssname ss 0))<br />     (setq endata (entget ename))<br />     (setq oldlay (cdr (assoc 8 endata)))<br />     (command "chprop" ss "" "la" "ZTEMP" "") <br /> <br /> (if (= (sslength ss) 4)<br />   (progn   <br />     (setq i 0)<br />     (repeat (sslength ss)<br /> <br />       (setq ename (ssname ss i))<br />       (command "chprop" ename "" "la" "ZZTEMP" "")    <br />       (setq endata (entget ename))<br />       (setq pt1 (cdr (assoc 10 endata)))<br />       (setq pt2 (cdr (assoc 11 endata)))<br />       <br />       (setq ppf (list pt1 pt2))<br />       (setq ssk (ssget "F" ppf)) <br />       (setq ssp (ssget "P" '((8 . "ZTEMP"))))<br /> ;(print (sslength SSP)) <br />         (if (= (sslength ssp) 2) <br />             (progn      <br />                  (setq enamel (ssname ssp 0))<br />                  (setq endata (entget enamel))<br />                  (setq ptr11 (cdr (assoc 10 endata)))<br />                  (setq ptr12 (cdr (assoc 11 endata)))<br />                  (setq ptrim1 (inters pt1 pt2 ptr11 ptr12 nil))<br />                  (setq enamel (ssname ssp 1))<br />                  (setq endata (entget enamel))<br />                  (setq ptr21 (cdr (assoc 10 endata)))<br />                  (setq ptr22 (cdr (assoc 11 endata)))<br />                  (setq ptrim2 (inters pt1 pt2 ptr21 ptr22 nil))<br />            (command "break" ename ptrim1 ptrim2) <br />            (setq ssz (ssget "X" '((8 . "ZZTEMP"))))<br />            (command "chprop" ssz "" "la" "ZTEMP" "")<br />              )   <br />         )    <br /> <br />       (setq i (+ i 1))<br />       <br />     )<br />       <br />   )  <br /> )<br />     (setq ssz (ssget "X" '((8 . "ZTEMP"))))<br />     (command "chprop" ssz "" "la" oldlay "")<br />     (setvar "osmode" selnum)<br />     (setvar "clayer" cly)<br /> (prin1)<br /> )<br /> (prin1)<br />

playboy

说实话挺好用的可是就是不能控制如何裁切而且只用于line线，能否改进一下。不过还是要对您的爱心说句谢谢，建议斑竹给你加分。

f5612140

1.以上程序適用4條線"井"字裁切,有空再寫在同一個程序下可適用不同的情況,依框選的條件自動判斷處理的方式
2.zhynt版主示範的應該是不同的程序做不同的結果