尺寸合并小bug

alexmai

垂直尺寸，只要把最下面的尺寸前置一下，就可以解决这个小bug
发现这个小bug，没修改能力，希望有人能解决这个小问题，感激!

源码在此贴：
http://bbs.mjtd.com/forum.php?mo ... %BA%CF%B2%A2&page=1

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

;;========================================<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 /> )<br /> ;;排序 0 水平 1 垂直 2 倾斜<br /> (defun Lsort (LT i)<br /> (cond<br /> ((or (= i 0)(= i 2))(setq Lt (vl-sort LT (function (lambda (e1 e2)(< (car e1) (car e2)))))))<br /> ((or (= i 1)(= i 2))(setq Lt (vl-sort LT (function (lambda (e1 e2)(< (cadr e1) (cadr e2)))))))<br /> ))<br /> <br /> (princ)

403181713

感谢大佬分享，学习学习

白色微風1991

感謝大佬分享，學習學習

KO你

标注断开与合并有时都会出现这种小问题，此问题解决了吗？

alexmai

KO你 发表于 2023-11-30 14:21
标注断开与合并有时都会出现这种小问题，此问题解决了吗？

目前用 迷你 标注 代替

jkop

感谢分享～收藏！

KO你

alexmai 发表于 2023-11-30 14:36
目前用 迷你 标注 代替

没有源码吗，想并到我自己的工具里，其他命令太多有些不是我需要的。