[LISP程序]：标注合并

梦断江南 · 发表于 2002-12-28 22:17:35

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

[FONT=courier new]
(princ "\ndmj=====dim join 标注合并--------lxx.2001.5.ok");;
;;=============================================================
(defun c:dmj (/ uo ux uy dme1 dmel1 dme2 dmel2 keyr ucsza dm1p13 dm1p14 dm1p10 dm2p13 np13x np14x )
(princ "\ndmj=====dim join 标注合并--------lxx.2001.5.ok")
(setq uo (getvar "ucsorg")
ux (getvar "ucsxdir")
uy (getvar "ucsydir")
)
(command "cmdecho" "0" "osnap" "nea" "ucs" "")
(defun *error* (msg) (print msg)(command ".ucs" "3" uo ux uy)(setq *error* nil))
(while (progn
(setq dme1 (car(entsel "\n点选要合并的第一个dim:"))
dmel1 (entget dme1)
dme2 (car(entsel "\n点选要合并的第二个dim:"))
dmel2 (entget dme2)
)
(and (member '(0 . "DIMENSION") dmel1) (member '(0 . "DIMENSION") dmel2))
);end progn
(if (member '(100 . "AcDbRotatedDimension") dmel1) (setq keyr "T")(setq keyr nil))
(if keyr (setq ucsza (angtos (cdr (assoc 50 dmel1)) 0 3))
(setq ucsza (angtos (angle (cdr(assoc 14 dmel1)) (cdr(assoc 13 dmel1))) 0 3))
)
(command "ucs" "z" ucsza)
(setq dm1p13 (trans (cdr(assoc 13 dmel1)) 0 1)
dm1p14 (trans (cdr(assoc 14 dmel1)) 0 1)
dm1p10 (trans (cdr(assoc 10 dmel1)) 0 1)
dm2p13 (trans (cdr(assoc 13 dmel2)) 0 1)
dm2p14 (trans (cdr(assoc 14 dmel2)) 0 1)
np13x (min (car dm1p13)(car dm1p14)(car dm2p13)(car dm2p14))
np14x (max (car dm1p13)(car dm1p14)(car dm2p13)(car dm2p14))
)
(setq dmel1 (subst (cons 13 (trans (cons np13x (cdr dm1p13)) 1 0)) (assoc 13 dmel1) dmel1)
dmel1 (subst (cons 14 (trans (cons np14x (cdr dm1p14)) 1 0)) (assoc 14 dmel1) dmel1)
dmel1 (subst (cons 10 (trans (cons np14x (cdr dm1p10)) 1 0)) (assoc 10 dmel1) dmel1)
)
(entdel dme2)
(entmod dmel1)
(command "ucs" "")
);end while
(command ".ucs" "3" uo ux uy)
(setq *error* nil)
(princ)
)
[/FONT]

[FONT=courier new] 
(princ "\ndmj=====dim join 标注合并--------lxx.2001.5.ok");; 
;;============================================================= 
(defun c:dmj (/ uo ux uy dme1 dmel1 dme2 dmel2 keyr ucsza dm1p13 dm1p14 dm1p10 dm2p13 np13x np14x ) 
(princ "\ndmj=====dim join 标注合并--------lxx.2001.5.ok") 
(setq uo (getvar "ucsorg") 
      ux (getvar "ucsxdir") 
      uy (getvar "ucsydir") 
) 
(command "cmdecho" "0" "osnap" "nea" "ucs" "") 
(defun *error* (msg) (print msg)(command ".ucs" "3" uo ux uy)(setq *error* nil)) 
(while (progn 
         (setq dme1 (car(entsel "\n点选要合并的第一个dim:")) 
               dmel1 (entget dme1) 
               dme2 (car(entsel "\n点选要合并的第二个dim:")) 
               dmel2 (entget dme2) 
         ) 
         (and (member '(0 . "DIMENSION") dmel1) (member '(0 . "DIMENSION") dmel2)) 
       );end progn 
       (if (member '(100 . "AcDbRotatedDimension") dmel1) (setq keyr "T")(setq keyr nil)) 
       (if keyr (setq ucsza (angtos (cdr (assoc 50 dmel1)) 0 3)) 
           (setq ucsza (angtos (angle (cdr(assoc 14 dmel1)) (cdr(assoc 13 dmel1))) 0 3)) 
       ) 
       (command "ucs" "z" ucsza) 
       (setq dm1p13 (trans (cdr(assoc 13 dmel1)) 0 1) 
             dm1p14 (trans (cdr(assoc 14 dmel1)) 0 1) 
             dm1p10 (trans (cdr(assoc 10 dmel1)) 0 1) 
             dm2p13 (trans (cdr(assoc 13 dmel2)) 0 1) 
             dm2p14 (trans (cdr(assoc 14 dmel2)) 0 1) 
             np13x (min (car dm1p13)(car dm1p14)(car dm2p13)(car dm2p14)) 
             np14x (max (car dm1p13)(car dm1p14)(car dm2p13)(car dm2p14)) 
       ) 
       (setq dmel1 (subst (cons 13 (trans (cons np13x (cdr dm1p13)) 1 0)) (assoc 13 dmel1) dmel1) 
             dmel1 (subst (cons 14 (trans (cons np14x (cdr dm1p14)) 1 0)) (assoc 14 dmel1) dmel1) 
             dmel1 (subst (cons 10 (trans (cons np14x (cdr dm1p10)) 1 0)) (assoc 10 dmel1) dmel1) 
       ) 
       (entdel dme2) 
       (entmod dmel1) 
       (command "ucs" "") 
);end while 
(command ".ucs" "3" uo ux uy) 
(setq *error* nil) 
(princ) 
) 
 
  [/FONT]

aeo · 发表于 2003-2-5 21:50:05

跟以前别人的一样.
第一第二个dim都点同一个,
不见了?!!!!!!!

不过蛮简洁的.

sdwy19691229 · 发表于 2005-3-23 23:03:43

下了看14能用吗?

lujs02013579 · 发表于 2005-4-15 16:28:36

没人说呀
我也想问呀

liubinz · 发表于 2005-4-18 11:09:20

无介绍

xjlmlxbq · 发表于 2005-4-18 16:35:13

三年前的东东，一直没升级

szdn · 发表于 2006-2-13 16:43:38

谢谢楼主。请问还有没有标注分开的程序啊？

好为人师 · 发表于 2006-4-24 18:48:10

能够合并多个吗

hao3ren · 发表于 2006-4-26 00:52:03

如果是拆分应该怎么弄啊，我不会编程啊

li809 · 发表于 2006-4-30 00:14:48

是不是与天正的那个命令一样呀，下了看看

lynchwu · 发表于 2009-1-3 19:17:05

能同时合并多个标注吗？

fengsea · 发表于 2009-2-7 20:05:02

楼主能否改进成框选合并多个标注！要是有标注断开更好拉！

missby · 发表于 2009-2-8 08:19:15

还是不错的，高手就是多

wangdahu1980 · 发表于 2009-2-9 22:33:13

很感谢楼主无私分享！对刚接触的非常好，我好好用一下，再次感谢了！

hzh2000 · 发表于 2009-2-13 23:21:48

有什么实际意义吗？

账号		自动登录	找回密码
密码			立即注册

[LISP程序]：标注合并

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子