明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 801|回复: 2

[源码] 文本包围框

[复制链接]
发表于 2018-6-4 00:30 | 显示全部楼层 |阅读模式
(defun c:tt (/ box1 box2 dis i pt pt1 pt2 pt3 pt4 pts s1 ss_txt txt)
        (setvar "cmdecho" 0)
        ;边框是否放大
       
        (if (= eh_bgoff_dis_g nil)
                (setq eh_bgoff_dis_g 0)
        )
        (princ "\n如需放大外包框请输入偏移距离<")(princ eh_bgoff_dis_g)(princ ">:")
        (setq dis (getdist))       
        (if (= dis nil)
                (setq dis eh_bgoff_dis_g)
                (setq eh_bgoff_dis_g dis)
        )
       
        (setq ss_txt (ssget '((0 . "TEXT,MTEXT"))))       
        (setq i -1)
        (while (setq s1 (ssname ss_txt (setq i (1+ i))))               
                (if (EH-Get-EntTypeCompare s1 "TEXT")
                        (progn
                                (setq txt (EH-Get-EntDxf s1 '(40 1 10 41)))                               
                                (setq pt (caddr txt))
                                (setq pts (textbox (list (cons 40 (car txt)) (cons 1 (cadr txt))(cons 41 (nth 3 txt)))))                                                               
                                (setq pt1 (EH-Vector-Add pt (car pts)))
                                (setq pt3 (EH-Vector-Add pt (cadr pts)))                               
                                (setq pt2 (list (car pt1)(cadr pt3)))
                                (setq pt4 (list (car pt3)(cadr pt1)))
                        )                                       
                )
                (if (EH-Get-EntTypeCompare s1 "MTEXT")
                        (progn
                                (setq pt1 (EH-Get-EntDxf s1 '(10 42 43)))                               
                                (setq box1 (cadr  pt1))
                                (setq box2 (caddr pt1))
                                (setq pt2 (car pt1))
                                (setq pt1 (list (car pt2) (- (cadr pt2) box2)))
                                (setq pt3 (list (+ (car pt2) box1) (cadr pt2)))
                                (setq pt4 (list (+ (car pt2) box1) (- (cadr pt2) box2)))                                                                                                                                                               
                        )                                               
                )
                (if (= dis 0)
                        nil
                        (setq
                                pt1 (list (- (car pt1) dis) (+ (cadr pt1) dis))
                                pt2 (list (- (car pt2) dis) (- (cadr pt2) dis))
                                pt3 (list (+ (car pt3) dis) (- (cadr pt3) dis))
                                pt4 (list (+ (car pt4) dis) (+ (cadr pt4) dis))
                        );setq
                )
                (if pt4
                        (entmake
                                (list '(0 . "LWPOLYLINE")
                                        '(100 . "AcDbEntity")
                                        '(100 . "AcDbPolyline")
                                        '(8 . "中Z-13----标注")
                                        '(90 . 4)
                                        '(70 . 1)
                                        (cons 10 pt1)
                                        (cons 10 pt2)        
                                        (cons 10 pt3)
                                        (cons 10 pt4)                
                                )                                                
                        )                       
                )       
        )
        (setvar "cmdecho" 1)
        (princ)
) ;defun_end


发表于 2018-6-4 03:55 来自手机 | 显示全部楼层
沙发顶楼主一个
发表于 2018-6-4 07:53 | 显示全部楼层
缺少自定义函数:EH-Get-EntDxf、EH-Get-EntTypeCompare、EH-Vector-Add
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 15:38 , Processed in 0.236639 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表