alexmai 发表于 2021-10-2 21:10:11

尺寸合并小bug

本帖最后由 alexmai 于 2021-10-2 22:36 编辑

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

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



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

(defun centsel (msg f)
(while (if (setq el (car (entsel msg))) (if (= (cdr (assoc 0 (entget el))) f) nil t) nil)) el
)
;;取值dxf
(defun dxf (x e)(cdr (assoc x e)))
;;求垂足
(defun ptper (pt0 pt1 pt2)
(inters pt0 (polar pt0 (+ (angle pt1 pt2) (/ pi 2)) 1.0) pt1 pt2 nil)
)
;;排序 0 水平 1 垂直 2 倾斜
(defun Lsort (LT i)
(cond
((or (= i 0)(= i 2))(setq Lt (vl-sort LT (function (lambda (e1 e2)(< (car e1) (car e2)))))))
((or (= i 1)(= i 2))(setq Lt (vl-sort LT (function (lambda (e1 e2)(< (cadr e1) (cadr e2)))))))
))

(princ)




403181713 发表于 2021-10-3 23:01:21

感谢大佬分享，学习学习

白色微風1991 发表于 2021-10-4 07:23:55

感謝大佬分享，學習學習

KO你 发表于 2023-11-30 14:21:30

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

alexmai 发表于 2023-11-30 14:36:06

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

目前用 迷你 标注 代替



jkop 发表于 2023-11-30 15:57:34

感谢分享～收藏！

KO你 发表于 2023-11-30 22:22:40

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

没有源码吗，想并到我自己的工具里，其他命令太多有些不是我需要的。
页: [1]
查看完整版本: 尺寸合并小bug