不知道标注全局比例？就动态修改。附: 标注断开及连续标注，标注合并

yxp

1 动态全局比例
     同时更新当前修改的标注样式的全局比例，使其对后续标注有效

动态全局比例源码:

2 标注断开+连续标注
     如果取点在标注内，就是断开，取点在标注外就是连续标注。

标注断开及连续，源码:

3 标注合并
     水平、垂直、对齐标注可批量一次选择，各自合并。

标注合并源码:



4 批量修改标注全局比例
非动态，手动输入比例
批量修改比例源码:  

.

yefei812678

yxp 发表于 2013-6-30 22:06
sorry ，原程序已更新，如果你不想下载就用下面的getmxy函数,替换原来的同名函数即可，Lsort 函数在标注断 ...

还是不行啊？

qazxswk

yxp 发表于 2013-6-29 02:59
哈哈，难道这就是抛砖引玉？

这个代码，能不能修改为，直接连续标注，而不用先选择标注再进行连续标注。

tianyi1230

沙发顶一个，

xyp1964

yxp

哈哈，难道这就是抛砖引玉？

2. 
   
3. ;;========================================
   
4. ;; 标注断开及连续标注程序
   
5. ;; by  明经通道  QQ: 9034598 2009年8月15日
   
6. ;;========================================
   
7. (vl-load-com)
   
8. (defun c:ddr (/ n x ent entL p2 p3 px1 px2 py1 py2 ptdd xl sa pt0 ppt ptdd)
   
9. (setvar "cmdecho" 0)
   
10. (command "undo" "be")
    
11. (setq entL '())
    
12. (if (setq ent (centsel "\n选择标注 或 <退出>:" "DIMENSION"))
    
13.    (progn
    
14.      (setq x (entget ent)
    
15.         entL (cons ent entL)
    
16.           p2 (dxf 13 x)
    
17.           p3 (dxf 14 x)
    
18.           px1 (list (car p2) (/ (+ (cadr p2)(cadr p3)) 2.0))
    
19.           px2 (list (car p3) (/ (+ (cadr p2)(cadr p3)) 2.0))
    
20.           py1 (list (/ (+ (car p2)(car p3)) 2.0) (cadr p2))
    
21.           py2 (list (/ (+ (car p2)(car p3)) 2.0) (cadr p3))
    
22.           ptdd (list p2 p3)
    
23.           XL (entget (dxf -2 (tblsearch "block" (dxf 2 x))))
    
24.           SA (abs (sin (angle (dxf 10 xl) (dxf 11 xl)))))
    
25.    (while (setq pt0 (getpoint "\n取点 或 <退出>:"))
    
26.        (command ".copy" ent "" "0,0" "@")
    
27.        (setq entL (cons (entlast) entL))
    
28.     (cond
    
29.       ((equal SA 1 1e-6) ;;水平
    
30.          (setq ptdd (cons (ptper pt0 px1 px2) ptdd)
    
31.                  ppt (Lsort ptdd 0))
    
32.         )
    
33.       ((equal SA 0 1e-6) ;;垂直
    
34.          (setq ptdd (cons (ptper pt0 py1 py2) ptdd)
    
35.                 ppt (Lsort ptdd 1))
    
36.        )
    
37.        (t (setq ptdd (cons (ptper pt0 p2 p3) ptdd)
    
38.             ppt (Lsort ptdd 2)))
    
39.       )
    
40.        (setq ppL (mapcar 'list ppt (cdr ppt))
    
41.               n 0)
    
42.          (repeat (length ppL)
    
43.            (setq xf (entget (nth n entL))
    
44.                 nxf (subst (cons 13 (car  (nth n ppL)))(assoc 13 xf) xf)
    
45.                 wxf (subst (cons 14 (cadr (nth n ppL)))(assoc 14 nxf) nxf)
    
46.                 n (1+ n))
    
47.            (entmod wxf)
    
48.          )
    
49.      ))
    
50.   (princ "\n退出")
    
51. )
    
52.   (command "undo" "e") (setvar "cmdecho" 1)
    
53.   (princ)
    
54. )
    
55. 
    
56. (defun centsel (msg f)
    
57. (while (if (setq el (car (entsel msg))) (if (= (cdr (assoc 0 (entget el))) f) nil t) nil)) el
    
58. )
    
59. ;;取值dxf
    
60. (defun dxf (x e)(cdr (assoc x e)))
    
61. ;;求垂足
    
62. (defun ptper (pt0 pt1 pt2)
    
63. (inters pt0 (polar pt0 (+ (angle pt1 pt2) (/ pi 2)) 1.0) pt1 pt2 nil)
    
64. )

<br /> ;;========================================<br /> ;; 标注断开及连续标注程序<br /> ;; by  明经通道  QQ: 9034598 2009年8月15日<br /> ;;========================================<br /> (vl-load-com)<br /> (defun c:ddr (/ n x ent entL p2 p3 px1 px2 py1 py2 ptdd xl sa pt0 ppt ptdd)<br /> (setvar "cmdecho" 0)<br /> (command "undo" "be")<br /> (setq entL '())<br /> (if (setq ent (centsel "\n选择标注 或 <退出>:" "DIMENSION"))<br />    (progn<br />      (setq x (entget ent)<br />         entL (cons ent entL)<br />           p2 (dxf 13 x)<br />           p3 (dxf 14 x)<br />           px1 (list (car p2) (/ (+ (cadr p2)(cadr p3)) 2.0))<br />           px2 (list (car p3) (/ (+ (cadr p2)(cadr p3)) 2.0))<br />           py1 (list (/ (+ (car p2)(car p3)) 2.0) (cadr p2))<br />           py2 (list (/ (+ (car p2)(car p3)) 2.0) (cadr p3))<br />           ptdd (list p2 p3)<br />           XL (entget (dxf -2 (tblsearch "block" (dxf 2 x))))<br />           SA (abs (sin (angle (dxf 10 xl) (dxf 11 xl)))))<br />    (while (setq pt0 (getpoint "\n取点 或 <退出>:"))<br />        (command ".copy" ent "" "0,0" "@")<br />        (setq entL (cons (entlast) entL))<br />     (cond<br />       ((equal SA 1 1e-6) ;;水平<br />          (setq ptdd (cons (ptper pt0 px1 px2) ptdd)<br />                  ppt (Lsort ptdd 0))<br />         )<br />       ((equal SA 0 1e-6) ;;垂直<br />          (setq ptdd (cons (ptper pt0 py1 py2) ptdd)<br />                 ppt (Lsort ptdd 1))<br />        )<br />        (t (setq ptdd (cons (ptper pt0 p2 p3) ptdd)<br />             ppt (Lsort ptdd 2)))<br />       )<br />        (setq ppL (mapcar 'list ppt (cdr ppt))<br />               n 0)<br />          (repeat (length ppL)<br />            (setq xf (entget (nth n entL))<br />                 nxf (subst (cons 13 (car  (nth n ppL)))(assoc 13 xf) xf)<br />                 wxf (subst (cons 14 (cadr (nth n ppL)))(assoc 14 nxf) nxf)<br />                 n (1+ n))<br />            (entmod wxf)<br />          )<br />      ))<br />   (princ "\n退出")<br /> )<br />   (command "undo" "e") (setvar "cmdecho" 1)<br />   (princ)<br /> )<br /> <br /> (defun centsel (msg f)<br /> (while (if (setq el (car (entsel msg))) (if (= (cdr (assoc 0 (entget el))) f) nil t) nil)) el<br /> )<br /> ;;取值dxf<br /> (defun dxf (x e)(cdr (assoc x e)))<br /> ;;求垂足<br /> (defun ptper (pt0 pt1 pt2)<br /> (inters pt0 (polar pt0 (+ (angle pt1 pt2) (/ pi 2)) 1.0) pt1 pt2 nil)<br /> )

bai2000

楼主好帅啊，能支持天正的标注么?

xiaxiang

这个功能不错，支持一下

zlg258369

yxp 发表于 2013-6-29 02:59
哈哈，难道这就是抛砖引玉？再来一个。

这个不错呦

davide888

真不错  神人

yangist

yxp 发表于 2013-6-29 02:59
哈哈，难道这就是抛砖引玉？再来一个。

标注分解后缺少个删除原标注的步骤

davide888

谢谢源码分享