[LISP程序]：标注断开1

梦断江南

；断开标注
；支持各种ucs

2. [FONT=century gothic]
   
3. (princ "\ndmd====dim 标注断开(1次)-v1.01------------------lxx.2001.5ok")
   
4. ;;===========================================================
   
5. ;;v1.01修正ucs非world时bug;  增加对dimstyle的识别；
   
6. ;;===========================================================
   
7. (defun c:dmd (/ uo ux uy odims ent entl entl2 ptd1 p10 p13 p14 ang1 ang2 ptd2 np14 np10)
   
8. (princ "\ndmd====dim 标注断开-v1.01-------------------lxx.2001.5ok")
   
9. (setq uo (getvar "ucsorg")
   
10.       ux (getvar "ucsxdir")
    
11.       uy (getvar "ucsydir")
    
12.       odims (getvar "dimstyle")
    
13. )
    
14. (command "cmdecho" "0" "osnap" "nea")
    
15. (command "ucs" "")
    
16. (defun *error* (msg) (print "退出程序")(command ".ucs" "3" uo ux uy ".dimstyle" "r" odims)(setq *error* nil)(princ))
    
17. (while
    
18.   (setq ent (car(entsel "\n选择要断开的dim:"))
    
19.         entl (entget ent)
    
20.         entl2 entl
    
21.   )
    
22.   (if (member '(0 . "DIMENSION") entl)
    
23.     (progn
    
24.       (setq ptd1 (getpoint "\n选择断开点:")
    
25.             p10 (cdr(assoc 10 entl))
    
26.             p13 (cdr(assoc 13 entl))
    
27.             p14 (cdr(assoc 14 entl))
    
28.             p3 (cdr (assoc 3 entl));;dimstyle
    
29.       )
    
30.       (if (member '(100 . "AcDbRotatedDimension") entl)
    
31.         (setq ang1 (cdr(assoc 50 entl)))
    
32.         (setq ang1 (angle p14 p13))
    
33.       )       
    
34.       (setq ang2 (+ ang1 (/ PI 2))
    
35.             ptd2 (polar ptd1 ang2 100)
    
36.             np14 (inters ptd1 ptd2 p13 p14 nil)
    
37.             np10 (inters ptd1 ptd2 p10 (polar p10 ang1 100) nil)
    
38.             entl (subst (cons 13 np14)(assoc 13 entl) entl)
    
39.             entl2 (subst (cons 10 np10)(assoc 10 entl2) entl2)
    
40.             entl2 (subst (cons 14 np14)(assoc 14 entl2) entl2)
    
41.       )
    
42.       (command ".dimstyle" "r" p3)
    
43.       (entmod entl)
    
44.       (entmake entl2)
    
45.       (setq ent2 (entlast))
    
46.       (command ".dim" "hom" ent ent2 "" ^c)
    
47.     );;end progn
    
48.   );;END IF
    
49. );;END WHILE
    
50. (command ".ucs" "3" uo ux uy
    
51.          ".dimstyle" "r" odims)
    
52. (setq *error* nil)
    
53. (princ)
    
54. )[/FONT]

[FONT=century gothic]<br /> (princ "\ndmd====dim 标注断开(1次)-v1.01------------------lxx.2001.5ok")<br /> ;;===========================================================<br /> ;;v1.01修正ucs非world时bug;  增加对dimstyle的识别；<br /> ;;===========================================================<br /> (defun c:dmd (/ uo ux uy odims ent entl entl2 ptd1 p10 p13 p14 ang1 ang2 ptd2 np14 np10)<br /> (princ "\ndmd====dim 标注断开-v1.01-------------------lxx.2001.5ok")<br /> (setq uo (getvar "ucsorg")<br />       ux (getvar "ucsxdir")<br />       uy (getvar "ucsydir")<br />       odims (getvar "dimstyle")<br /> )<br /> (command "cmdecho" "0" "osnap" "nea")<br /> (command "ucs" "")<br /> (defun *error* (msg) (print "退出程序")(command ".ucs" "3" uo ux uy ".dimstyle" "r" odims)(setq *error* nil)(princ))<br /> (while<br />   (setq ent (car(entsel "\n选择要断开的dim:"))<br />         entl (entget ent)<br />         entl2 entl<br />   )<br />   (if (member '(0 . "DIMENSION") entl)<br />     (progn<br />       (setq ptd1 (getpoint "\n选择断开点:")<br />             p10 (cdr(assoc 10 entl))<br />             p13 (cdr(assoc 13 entl))<br />             p14 (cdr(assoc 14 entl))<br />             p3 (cdr (assoc 3 entl));;dimstyle<br />       )<br />       (if (member '(100 . "AcDbRotatedDimension") entl) <br />         (setq ang1 (cdr(assoc 50 entl)))<br />         (setq ang1 (angle p14 p13))<br />       )        <br />       (setq ang2 (+ ang1 (/ PI 2))<br />             ptd2 (polar ptd1 ang2 100)<br />             np14 (inters ptd1 ptd2 p13 p14 nil)<br />             np10 (inters ptd1 ptd2 p10 (polar p10 ang1 100) nil)<br />             entl (subst (cons 13 np14)(assoc 13 entl) entl)<br />             entl2 (subst (cons 10 np10)(assoc 10 entl2) entl2)<br />             entl2 (subst (cons 14 np14)(assoc 14 entl2) entl2)<br />       )<br />       (command ".dimstyle" "r" p3)<br />       (entmod entl)<br />       (entmake entl2)<br />       (setq ent2 (entlast))<br />       (command ".dim" "hom" ent ent2 "" ^c)<br />     );;end progn<br />   );;END IF<br /> );;END WHILE<br /> (command ".ucs" "3" uo ux uy<br />          ".dimstyle" "r" odims)<br /> (setq *error* nil)<br /> (princ)<br /> )[/FONT]

烨006

我想要呀！可为什么下载不了？

汗！把上面的代码以。LSP格式加载在R14也用不了！

andyhua5240

找不到服务器，币也扣了！

xjlmlxbq

真下载不了?我传一个吧，不过没有楼主斑竹的好，不支持各种ucs

烨006

今天又试了一次，版主的程序是可以用的！多谢！
但有一小点不是满意：执行U的命令时不能一次回复，而要进行几次才行的！

yjtdkj

增加对dimstyle的识别；
上面这句是什么意思呀，请指教

tzylove

郁闷。下不了啊

zh_6531394

为什么用后尺寸不在原地,或不见了, 或180 转, 或拉得很长

li809

都下不了，气我

sdwy19691229

真的下不了，好麻烦。