[LISP程序]：剪齐dim标注边界线--v2

梦断江南

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

;;*** dmtr2=====dim trim 剪齐dim边界线--v2-----------lxx.2001v1;2002.10v2--<br /> ;;<br /> ;;      |   p11   |<br /> ;;    -   ------ p10 -<br /> ;;      |         |<br /> ;;     p13       p14<br /> <br /> (princ "\ndmtr2=====dim trim 剪齐dim边界线---v2 ----------lxx.2002\n")<br /> ;;;<br /> (defun c:dmtr2 ( / pt1 pt2 ss i ent entl p10 p13 p14 ptt np14 np13)<br /> (princ "\ndmtr2=====dim trim 剪齐dim边界线--v2 -----------lxx.2002")<br /> (command "_.undo" "be" ^c )<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 />       pt1 (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2) ) <br />       pt2 (polar pt1 (+ (/ PI 2) (angle p10 p14)) 100)<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 />

晨寒羽良

好东西好东西，以前自己研究怎么把天正建筑里的搞到天正结构里去，老是搞不定，现在好了

大尾巴狼

绝好
绝对好
绝对绝好

sgfwang

好是好。可是我不懂LISP。要学呀。

jbqiu

怎么用啊，我存了LISP格式，也加载了，可以用但是没有效果啊

梦断江南

演示

llg_llg

太好了,想用这个很久了

nlwangjie

好东西。

andyhua5240

谢谢斑竹，非常的好用！找了好久了！
谢谢！

wtj2258

有不让下了，埃

li809

非常好用的程序，以后不用手动调整了

bsq

最初由 晨寒羽良 发布
[B]好东西好东西，以前自己研究怎么把天正建筑里的搞到天正结构里去，老是搞不定，现在好了 [/B]

天正结构不是有吗？很好用啊

jintly

真的很不错的，谢谢版主，版主就是牛！

zfcinema

很好用，谢谢

xgz501

找你好心苦啊。以前在天正里用过