尺寸界线修剪

繁花落叶

下面用的是纯lisp写的“尺寸界线修剪”，有哪位能人可以把它改成简洁的vlisp呢？

2. ;;;;===Functions developed by Xiaoyu===
   
3. ;
   
4. ;          尺寸界线修剪 小宇 98.8.5 E-MAIL:CHXY@HOTMAIL.COM
   
5. ;
   
6. ;命令是dt，就是dimtrim的意思
   
7. (defun dfrmvz (p /)
   
8.   (if p (list (car p) (cadr p) 0.0))
   
9. )
   
10. (defun c:dt ( / n ss sn en pt10 pt13 pt14 ptx ptx1 ptx2 pt_1 pt_2 ang1 ang2
    
11.                    oexo ose1 ose2)
    
12. (if (and (setq pt_1 (getpoint "\n切断线第一点(切线要穿过尺寸线)<退出>: "))
    
13.          (setq pt_2 (getpoint pt_1 "\n切断线第二点(切线要穿过尺寸线)<退出>: "))
    
14.          (setq n 0 ss (ssget "F" (list pt_1 pt_2)))
    
15.     )
    
16.     (progn
    
17.       (setq oexo (getvar "dimexo"))
    
18.       (setq ose1 (getvar "dimse1"))
    
19.       (setq ose2 (getvar "dimse2"))
    
20.       (setvar "dimexo" 0.0)
    
21.       (setvar "dimse1" 0)
    
22.       (setvar "dimse2" 0)
    
23.       (setq ptx (mapcar '(lambda (x y) (* 0.5 (+ x y))) pt_1 pt_2))
    
24.       (while (setq sn (ssname ss n))
    
25.         (setq n (1+ n) en (entget sn))
    
26.         (if (= "DIMENSION" (cdr (assoc 0 en)))
    
27.           (progn
    
28.             (setq pt10 (cdr (assoc 10 en)) pt13 (cdr (assoc 13 en))
    
29.                   pt14 (cdr (assoc 14 en)) ang1 (angle pt10 pt14)
    
30.                   ang2 (+ ang1 (* 0.5 pi)) pt10 (dfrmvz pt10)
    
31.                   pt13 (dfrmvz pt13) pt14 (dfrmvz pt14)
    
32.                   pt_1 (inters pt13 (polar pt13 ang1 1000.)
    
33.                   pt10 (polar pt10 ang2 1000.) nil)
    
34.                   ptx (dfrmvz ptx) pt_2 (polar ptx ang2 1000.)
    
35.             )
    
36.             (if (and (setq ptx1 (inters pt10 pt14 ptx pt_2 nil))
    
37.                      (setq ptx2 (inters pt_1 pt13 ptx pt_2 nil)))
    
38.                 (progn
    
39.                    (setq en (subst (cons 14 ptx1) (assoc 14 en) en)
    
40.                          en (subst (cons 13 ptx2) (assoc 13 en) en)
    
41.                    )
    
42.                    (entmod en)
    
43.                 )
    
44.             )
    
45.           )
    
46.         )
    
47.       )
    
48.       (setvar "dimexo" oexo)
    
49.       (setvar "dimse1" ose1)
    
50.       (setvar "dimse2" ose2)
    
51.     )
    
52.   )
    
53.   (princ)
    
54. )

;;;;===Functions developed by Xiaoyu===<br /> ;<br /> ;          尺寸界线修剪 小宇 98.8.5 E-MAIL:CHXY@HOTMAIL.COM<br /> ;<br /> ;命令是dt，就是dimtrim的意思<br /> (defun dfrmvz (p /)<br />   (if p (list (car p) (cadr p) 0.0))<br /> )<br /> (defun c:dt ( / n ss sn en pt10 pt13 pt14 ptx ptx1 ptx2 pt_1 pt_2 ang1 ang2<br />                    oexo ose1 ose2)<br /> (if (and (setq pt_1 (getpoint "\n切断线第一点(切线要穿过尺寸线)<退出>: "))<br />          (setq pt_2 (getpoint pt_1 "\n切断线第二点(切线要穿过尺寸线)<退出>: "))<br />          (setq n 0 ss (ssget "F" (list pt_1 pt_2)))<br />     )<br />     (progn<br />       (setq oexo (getvar "dimexo"))<br />       (setq ose1 (getvar "dimse1"))<br />       (setq ose2 (getvar "dimse2"))<br />       (setvar "dimexo" 0.0)<br />       (setvar "dimse1" 0)<br />       (setvar "dimse2" 0)<br />       (setq ptx (mapcar '(lambda (x y) (* 0.5 (+ x y))) pt_1 pt_2))<br />       (while (setq sn (ssname ss n))<br />         (setq n (1+ n) en (entget sn))<br />         (if (= "DIMENSION" (cdr (assoc 0 en)))<br />           (progn<br />             (setq pt10 (cdr (assoc 10 en)) pt13 (cdr (assoc 13 en))<br />                   pt14 (cdr (assoc 14 en)) ang1 (angle pt10 pt14)<br />                   ang2 (+ ang1 (* 0.5 pi)) pt10 (dfrmvz pt10)<br />                   pt13 (dfrmvz pt13) pt14 (dfrmvz pt14)<br />                   pt_1 (inters pt13 (polar pt13 ang1 1000.)<br />                   pt10 (polar pt10 ang2 1000.) nil)<br />                   ptx (dfrmvz ptx) pt_2 (polar ptx ang2 1000.)<br />             )<br />             (if (and (setq ptx1 (inters pt10 pt14 ptx pt_2 nil))<br />                      (setq ptx2 (inters pt_1 pt13 ptx pt_2 nil)))<br />                 (progn<br />                    (setq en (subst (cons 14 ptx1) (assoc 14 en) en)<br />                          en (subst (cons 13 ptx2) (assoc 13 en) en)<br />                    )<br />                    (entmod en)<br />                 )<br />             )<br />           )<br />         )<br />       )<br />       (setvar "dimexo" oexo)<br />       (setvar "dimse1" ose1)<br />       (setvar "dimse2" ose2)<br />     )<br />   )<br />   (princ)<br /> )

注册

这个不错，收藏了

wjl1014

好东东。正在找。

luojunmax

很好用，支持