雨的节奏 发表于 2019-9-26 09:10:21

GS工具箱，快速拉线标注，简单、实用、源码



(defun c:DDF (/ minsize pt1 pt2 ss intlist x y lds olden pts1 pts2 n ens code i ptx endata)
(if ddf_old_minsize (setqminsize ddf_old_minsize))

(while (progn (initget"S")(setq pt1 (getpoint "\n指定标注起始方向 \n输入S可以设置过滤尺寸")))
(while (= "S" pt1)
       (if (null ddf_old_minsize)
         (setq minsize (getdist "\n请输入过滤尺寸,默认为【5mm】"))
         (setq minsize (getdist (strcat "\n请输入过滤尺寸,上次输入为【" (rtos ddf_old_minsize 2 2) "mm】"))))
      (if (null minsize) (setq minsize 5))
      (setq ddf_old_minsize minsize)
      (initget"S")
      (setq pt1 (getpoint "\n指定标注起始方向 \n输入S可以设置过滤尺寸"))
);end while

(if (null minsize) (setq minsize 5))
(setq ddf_old_minsize minsize)
(setq pt2 (getpoint pt1 "\n指定标注方向"))
(if (setq ss (ssget "F" (list pt1 pt2) '((0 . "*E,CIRCLE,ARC")(6 . "BYLAYER"))))
(progn
(setq intlist () endata (ssnamex ss))
(foreach x endata (foreach y (cdddr x) (setq intlist (cons (cadr y) intlist))))
;;点要排序一下才行,按从开始点的距离来排序

(setq lds (+ 10 (distance pt1 pt2)))
(setq intlist (vl-remove-if-not '(lambda (x) (<= (distance x pt1) lds)) intlist))
(setq intlist(vl-sortintlist   '(lambda (x y) (< (distance pt1 x) (distance pt1 y)))))
;;这里开始写标注程序
   (setq olden (entlast) ss (ssadd))
   (setq n 0)
   (repeat (- (length intlist) 1)
             (setq pts1 (nth n intlist)
                   pts2 (nth (1+ n) intlist))
             (if (> (distance pts1 pts2) minsize) (ddf_entmakedim pts1 pts2))
             (setq n (1+ n))
      );end repeat
(while (setq ens (entnext olden)) (setq ss (ssadd ens ss) olden ens))
;;下面开始来移动

(while (and
      (setq code (grread T 8))
      (/= 11 (car code))
      (/= 25 (car code))
      (/= 3 (car code))
      (= 5 (car code)))
      (redraw)
      (setq ptx (cadr code))
      (setq i 0)
      (repeat (sslength ss)
               (setq endata (entget (ssname ss i)))
               (entmod (subst (cons 10 ptx) (assoc 10 endata) endata ))
       (setq i (1+ i))
   ); end repeat
);end while
));end if
);end while
(princ "\n标注完成")
(prin1)
);end



(defun ddf_entmakedim (pt1 pt2 /)
(cond
((or (equal 0 (angle pt1 pt2) 0.001) (equal pi (angle pt1 pt2) 0.001))
          (entmake
          (list
         '(0 . "DIMENSION")
         '(100 . "AcDbEntity")
         '(100 . "AcDbDimension")
      (cons 10 pt1)
      '(70 . 32) '(1 . "")
      '(100 . "AcDbAlignedDimension")
      (cons 13 pt1) (cons 14 pt2)
       '(100 . "AcDbRotatedDimension")
    )
    )
)
((or (equal (/ pi 2) (angle pt1 pt2) 0.001) (equal (* pi 1.5) (angle pt1 pt2) 0.001))
   (entmake
      (list
      '(0 . "DIMENSION")
      '(100 . "AcDbEntity")
      '(100 . "AcDbDimension")
      (cons 10 pt1)
      '(70 . 33) '(1 . "")
   '(100 . "AcDbAlignedDimension")
    (cons 13 pt1) (cons 14 pt2)
    )
)
)
((and (null (equal 0 (angle pt1 pt2) 0.001)) (null (equal (/ pi 2) (angle pt1 pt2) 0.001)))
   (entmake
      (list
      '(0 . "DIMENSION")
      '(100 . "AcDbEntity")
      '(100 . "AcDbDimension")
      (cons 10 pt1)
      '(70 . 33) '(1 . "")
   '(100 . "AcDbAlignedDimension")
    (cons 13 pt1) (cons 14 pt2)
    )
)
)
);end cond
);end
(prin1)


















      

liuxiooang 发表于 2019-12-19 13:12:56

不会用，脑壳痛。

liuties 发表于 2019-11-13 10:12:54

感谢楼主分享   很实用

cghdy 发表于 2019-11-12 12:52:54

cghdy 发表于 2019-11-12 12:50
大兄弟。能不能整个完整版的，有错误用不得

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=180410&highlight=%C0%AD%CF%DF%B1%EA%D7%A2

KO你 发表于 2019-10-10 04:50:33

这个和CAD默认的qdim快速标注有什么不同吗，是否交点标注。怎么不见运行命令

纵横八方 发表于 2019-9-26 11:12:02

能斜拉吗，迷你的可以斜拉

664571221 发表于 2019-9-26 16:55:20

怎么用不起来大兄弟？？

BaoWSE 发表于 2019-9-26 20:42:42

非常好！收藏学习！

纵横八方 发表于 2019-9-27 07:36:06

大胸弟，的程序bug太多

pengfei2010 发表于 2019-9-27 08:21:06

哈哈不错，思路很好，我做的虽然比你这个强大，但是你这个思路非常简洁，思路值得借鉴

664571221 发表于 2019-9-27 14:10:46

pengfei2010 发表于 2019-9-27 08:21
哈哈不错，思路很好，我做的虽然比你这个强大，但是你这个思路非常简洁，思路值得借鉴

能发一个吗大兄弟？？？

bbswen 发表于 2019-9-27 15:12:37

不错，谢谢楼主

iszc 发表于 2019-9-27 15:16:48

收藏学习！！！

xiangganglv 发表于 2019-9-28 14:08:49

:lol会技术，点赞！会分享，点赞！说话还好听，更要点赞。
页: [1] 2 3
查看完整版本: GS工具箱，快速拉线标注，简单、实用、源码