求贱人工具箱中的一个程序高手帮忙谢谢！！！

njut_prince · 发表于 2011-10-30 11:07:57

想要一个单独的程序，输入JK就能出现这个对话框，设置好后可以框选单行文本

cushi · 发表于 2011-11-1 15:28:52

本帖最后由 cushi 于 2011-11-1 15:29 编辑

简单的文字加外框程序，自已补充哦。
(defun c:j (/ b1 c1 d1 e1)
(setq d1 (getreal "请输入空隔距离:"))
(princ b1)
(while (setq c1 (entsel "\n请选择对象:"))
  (setq e1 (entget (car c1)))
  (if (= (cdr (assoc 0 e1)) "TEXT") (progn
(setq b1 (textbox e1))
(command "rectang"
   (mapcar '- (cdr (assoc 10 e1)) (car b1) (list d1 d1))
   (mapcar '+ (cdr (assoc 10 e1)) (cadr b1) (list d1 d1))
)
))
)
)

wau2000022 · 发表于 2012-5-16 00:01:35

这个功能我可以弄,需要的话,加我的QQ群:93525062

心是为何物 · 发表于 2012-5-20 19:11:31

有需要请加QQ269483126

longer1000 · 发表于 2012-6-22 12:58:07

ooooooooooooooooooooooooooo

soly2006 · 发表于 2012-6-23 14:10:42

;;-----------------------=={ Box Text }==---------------------;;
;; ;;
;; Frames Text or MText objects with an LWPolyline, with ;;
;; optional offset. Works in all UCS/Views. ;;
;;------------------------------------------------------------;;
;;------------------------------------------------------------;;
(defun c:BT nil (c:BoxText))
(defun c:BoxText nil
;; � Lee Mac 2010
(
(lambda ( ss off i / e )
(if ss
(while (setq e (ssname ss (setq i (1+ i))))
(entmakex
(append
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(assoc 8 (entget e))
(cons 90 4)
(cons 70 1)
(cons 38 (caddr (cdr (assoc 10 (entget e)))))
(assoc 210 (entget e))
)
(mapcar '(lambda ( x ) (cons 10 x)) (LM:GetTextBox e off))
)
)
)
)
)
(ssget '((0 . "TEXT,MTEXT")))
(setq *o*
(cond
(
(getdist
(strcat "\nSpecify Offset <"
(rtos
(setq *o*
(cond ( *o* ) ( (* 0.5 (getvar 'TEXTSIZE)) ))
)
)
"> : "
)
)
)
( *o* )
)
)
-1
)
(princ)
)
;;---------------------=={ Get Text Box }==-------------------;;
;; ;;
;; Returns a point list describing a rectangle framing the ;;
;; specified text or mtext entity with optional offset ;;
;;------------------------------------------------------------;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; ent - Text or MText ename ;;
;; off - offset (may be zero) ;;
;;------------------------------------------------------------;;
;; Returns: List of Points (in OCS) describing text frame ;;
;;------------------------------------------------------------;;
(defun LM:GetTextBox ( ent off / dx lst base rotn norm w h matrix )
;; � Lee Mac 2010
(setq dx (lambda ( x l ) (cdr (assoc x l))))
(if
(setq lst
(cond
(
(eq "TEXT" (dx 0 (setq l (entget ent))))
(setq base (dx 10 l) rotn (dx 50 l))
(
(lambda ( data )
(mapcar
(function
(lambda ( funcs )
(mapcar
(function
(lambda ( func )
((eval (car func)) ((eval (cdr func)) data) off)
)
)
funcs
)
)
)
(list
(list (cons '- 'caar ) (cons '- 'cadar ))
(list (cons '+ 'caadr) (cons '- 'cadar ))
(list (cons '+ 'caadr) (cons '+ 'cadadr))
(list (cons '- 'caar ) (cons '+ 'cadadr))
)
)
)
(textbox l)
)
)
(
(eq "MTEXT" (dx 0 l))
(setq norm (dx 210 l) base (trans (dx 10 l) 0 norm)
rotn (angle '(0. 0. 0.) (trans (dx 11 l) 0 norm))
w (dx 42 l) h (dx 43 l)
)
(
(lambda ( org )
(mapcar
(function
(lambda ( o ) (mapcar '+ org o))
)
(list
(list (- off) (- off))
(list (+ w off) (- off))
(list (+ w off) (+ h off))
(list (- off) (+ h off))
)
)
)
(
(lambda ( j )
(list
(cond
(
(member j '(2 5 8)) (/ w -2.)
)
(
(member j '(3 6 9)) (- w)
)
( 0. )
)
(cond
(
(member j '(1 2 3)) (- h)
)
(
(member j '(4 5 6)) (/ h -2.)
)
( 0. )
)
)
)
(dx 71 l)
)
)
)
)
)
(progn
(setq matrix
(list
(list (cos rotn) (sin (- rotn)) 0.)
(list (sin rotn) (cos rotn) 0.)
(list 0. 0. 1.)
)
)
(mapcar
(function
(lambda ( point )
(mapcar '+
(mapcar
(function
(lambda ( r ) (apply '+ (mapcar '* r point)))
)
matrix
)
(reverse (cdr (reverse base)))
)
)
)
lst
)
)
)
)

;;-----------------------=={ Box Text }==---------------------;; 
;;                                                            ;; 
;;  Frames Text or MText objects with an LWPolyline, with     ;; 
;;  optional offset. Works in all UCS/Views.                  ;; 
;;------------------------------------------------------------;; 
;;  Author: Lee Mac, Copyright &#65533; 2010 - <a href="http://www.lee-mac.com" target="_blank">www.lee-mac.com</a>       ;; 
;;------------------------------------------------------------;; 
 
(defun c:BT nil (c:BoxText)) 
 
(defun c:BoxText nil 
  ;; &#65533; Lee Mac 2010 
 
  ( 
    (lambda ( ss off i / e ) 
      (if ss 
        (while (setq e (ssname ss (setq i (1+ i)))) 
          (entmakex 
            (append 
              (list 
                (cons 0 "LWPOLYLINE") 
                (cons 100 "AcDbEntity") 
                (cons 100 "AcDbPolyline") 
                (assoc 8 (entget e)) 
                (cons 90 4) 
                (cons 70 1) 
                (cons 38 (caddr (cdr (assoc 10 (entget e))))) 
                (assoc 210 (entget e)) 
              ) 
              (mapcar '(lambda ( x ) (cons 10 x)) (LM:GetTextBox e off)) 
            ) 
          ) 
        ) 
      ) 
    ) 
    (ssget '((0 . "TEXT,MTEXT"))) 
    (setq *o* 
      (cond 
        ( 
          (getdist 
            (strcat "\nSpecify Offset <" 
              (rtos 
                (setq *o* 
                  (cond ( *o* ) ( (* 0.5 (getvar 'TEXTSIZE)) )) 
                ) 
              ) 
              "> : " 
            ) 
          ) 
        ) 
        ( *o* ) 
      ) 
    ) 
    -1 
  ) 
 
  (princ) 
) 
 
;;---------------------=={ Get Text Box }==-------------------;; 
;;                                                            ;; 
;;  Returns a point list describing a rectangle framing the   ;; 
;;  specified text or mtext entity with optional offset       ;; 
;;------------------------------------------------------------;; 
;;  Author: Lee Mac, Copyright &#65533; 2010 - <a href="http://www.lee-mac.com" target="_blank">www.lee-mac.com</a>       ;; 
;;------------------------------------------------------------;; 
;;  Arguments:                                                ;; 
;;  ent - Text or MText ename                                 ;; 
;;  off - offset (may be zero)                                ;; 
;;------------------------------------------------------------;; 
;;  Returns:  List of Points (in OCS) describing text frame   ;; 
;;------------------------------------------------------------;; 
 
(defun LM:GetTextBox ( ent off / dx lst base rotn norm w h matrix ) 
  ;; &#65533; Lee Mac 2010 
 
  (setq dx (lambda ( x l ) (cdr (assoc x l)))) 
 
  (if 
    (setq lst 
      (cond 
        ( 
          (eq "TEXT" (dx 0 (setq l (entget ent)))) 
 
          (setq base (dx 10 l) rotn (dx 50 l)) 
 
          ( 
            (lambda ( data ) 
              (mapcar 
                (function 
                  (lambda ( funcs ) 
                    (mapcar 
                      (function 
                        (lambda ( func ) 
                          ((eval (car func)) ((eval (cdr func)) data) off) 
                        ) 
                      ) 
                      funcs 
                    ) 
                  ) 
                ) 
                (list 
                  (list (cons '- 'caar ) (cons '- 'cadar )) 
                  (list (cons '+ 'caadr) (cons '- 'cadar )) 
                  (list (cons '+ 'caadr) (cons '+ 'cadadr)) 
                  (list (cons '- 'caar ) (cons '+ 'cadadr)) 
                ) 
              ) 
            ) 
            (textbox l) 
          ) 
        ) 
        ( 
          (eq "MTEXT" (dx 0 l)) 
 
          (setq norm (dx 210 l) base (trans (dx 10 l) 0 norm) 
          
                rotn (angle '(0. 0. 0.) (trans (dx 11 l) 0 norm)) 
 
                w (dx 42 l) h (dx 43 l) 
          ) 
          ( 
            (lambda ( org ) 
              (mapcar 
                (function 
                  (lambda ( o ) (mapcar '+ org o)) 
                ) 
                (list 
                  (list (-   off) (-   off)) 
                  (list (+ w off) (-   off)) 
                  (list (+ w off) (+ h off)) 
                  (list (-   off) (+ h off)) 
                ) 
              ) 
            ) 
            ( 
              (lambda ( j ) 
                (list 
                  (cond 
                    ( 
                      (member j '(2 5 8)) (/ w -2.) 
                    ) 
                    ( 
                      (member j '(3 6 9)) (- w) 
                    ) 
                    ( 0. ) 
                  ) 
                  (cond 
                    ( 
                      (member j '(1 2 3)) (- h) 
                    ) 
                    ( 
                      (member j '(4 5 6)) (/ h -2.) 
                    ) 
                    ( 0. ) 
                  ) 
                ) 
             ) 
             (dx 71 l) 
           ) 
         ) 
       ) 
     ) 
   ) 
    (progn 
      (setq matrix 
         (list 
           (list (cos rotn) (sin (- rotn)) 0.) 
           (list (sin rotn) (cos    rotn)  0.) 
           (list     0.           0.       1.) 
         ) 
      ) 
 
      (mapcar 
        (function 
          (lambda ( point ) 
            (mapcar '+ 
              (mapcar 
                (function 
                  (lambda ( r ) (apply '+ (mapcar '* r point))) 
                ) 
                matrix 
              ) 
              (reverse (cdr (reverse base))) 
            ) 
          ) 
        ) 
        lst 
      ) 
    ) 
  ) 
)

r6831800 · 发表于 2012-7-7 11:12:16

不错哦。、贱人好像现在有破解版的。

账号		自动登录	找回密码
密码			注册

求贱人工具箱中的一个程序高手帮忙谢谢！！！

本帖子中包含更多资源

相关帖子

简单的文字加外框程序

点评

求贱人工具箱中的一个程序 高手帮忙 谢谢！！！

本帖子中包含更多资源

相关帖子

简单的文字加外框程序

点评

求贱人工具箱中的一个程序高手帮忙谢谢！！！