[LISP程序]：我也贴一个：dim尺寸界线修剪

雄啸

2. 
   
3.   [FONT=courier new]
   
4. (defun c:dmtr ( / uo ux uy pt1 pt2 ss i ent entl p10 p13 p14 ptt np14 np13)
   
5. (princ "\ndmtr=====dim trim 剪齐dim边界线--v2-----------lxx.2001")
   
6. (command "_.undo" "be" ^c );;;;;"_.ucs" "")
   
7. ;;;
   
8. (defun *error* (msg) (print msg)(command  "_.undo" "e" ^c)(setq *error* nil))
   
9. ;;;
   
10. (setq pt1 (getpoint "\n定义修剪界线 (只处理相交的dim),起点:")
    
11.       pt2 (getpoint pt1 "\n终点:")
    
12.       ss (ssget "f" (list pt1 pt2) '((0 . "DIMENSION")) )
    
13.       pt1 (trans pt1 1 0)
    
14.       pt2 (trans pt2 1 0)
    
15.       i 0
    
16. )
    
17. (repeat (sslength ss)
    
18. (setq ent (ssname ss i)
    
19.       entl (entget ent)
    
20.       p10 (cdr (assoc 10 entl))
    
21.       p13 (cdr (assoc 13 entl))
    
22.       p14 (cdr (assoc 14 entl))
    
23.       ptt (cdr (assoc 11 entl))
    
24.       i (1+ i)
    
25.       np14 (inters pt1 pt2 p14 p10 nil)
    
26. )
    
27. (if (not(member '(100 . "AcDbRotatedDimension") entl))
    
28.      (setq np13 (polar np14 (angle p14 p13) (distance p14 p13)))
    
29.      (setq np13 (inters pt1 pt2 p13 (polar p13 (angle p14 p10) 100) nil))
    
30. )
    
31. (setq entl (subst (cons 13 np13) (assoc 13 entl) entl)
    
32.        entl (subst (cons 14 np14) (assoc 14 entl) entl)
    
33. )
    
34.   (entmod entl)
    
35. );end repeat
    
36. (command "_.undo" "e" ^c)
    
37. (setq *error* nil)
    
38. (princ)
    
39. )
    
40. 
    
41.   [/FONT]
    

<br />   [FONT=courier new]<br /> (defun c:dmtr ( / uo ux uy pt1 pt2 ss i ent entl p10 p13 p14 ptt np14 np13)<br /> (princ "\ndmtr=====dim trim 剪齐dim边界线--v2-----------lxx.2001")<br /> (command "_.undo" "be" ^c );;;;;"_.ucs" "")<br /> ;;;<br /> (defun *error* (msg) (print msg)(command  "_.undo" "e" ^c)(setq *error* nil))<br /> ;;;<br /> (setq pt1 (getpoint "\n定义修剪界线 (只处理相交的dim),起点:")<br />       pt2 (getpoint pt1 "\n终点:")<br />       ss (ssget "f" (list pt1 pt2) '((0 . "DIMENSION")) )<br />       pt1 (trans pt1 1 0)<br />       pt2 (trans pt2 1 0)<br />       i 0<br /> )<br /> (repeat (sslength ss)<br /> (setq ent (ssname ss i)<br />       entl (entget ent)<br />       p10 (cdr (assoc 10 entl))<br />       p13 (cdr (assoc 13 entl))<br />       p14 (cdr (assoc 14 entl))<br />       ptt (cdr (assoc 11 entl))<br />       i (1+ i)<br />       np14 (inters pt1 pt2 p14 p10 nil)<br /> )<br /> (if (not(member '(100 . "AcDbRotatedDimension") entl))<br />      (setq np13 (polar np14 (angle p14 p13) (distance p14 p13)))<br />      (setq np13 (inters pt1 pt2 p13 (polar p13 (angle p14 p10) 100) nil))<br /> )<br /> (setq entl (subst (cons 13 np13) (assoc 13 entl) entl)<br />        entl (subst (cons 14 np14) (assoc 14 entl) entl)<br /> )<br />   (entmod entl)<br /> );end repeat<br /> (command "_.undo" "e" ^c)<br /> (setq *error* nil)<br /> (princ)<br /> )<br /> <br />   [/FONT]<br />

aeo

蛮好
*error*设置方法不好.把原来的设置给清了

402326352

x谢谢