基于纯lisp编制的智能修剪程序

lizhiqiang9801

好程序 可惜没钱 回复挣个小钱吧  

asd19400

没钱的日子很难过啊

qyming

支持楼主

sdflq

好程序，支持楼主

xing979020

还不错。
可能不好控制吧

coco25825

这段代码可以使用楼主演示的第一张图

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

(defun c:cj()<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 />

chenjian2159

coco25825 发表于 2012-1-15 12:10
这段代码可以使用楼主演示的第一张图

命令:  CJ
First corner:
Second corner:; 错误: 参数类型错误: lselsetp nil

yjycad

朋友没反应啊，怎么回事啊？最后二个明经币了别浪费了啊！

yjycad

经测试多线PL没用，只能用直线L

lgzh0008

照顾穷人吧