边界创建Lisp-按Tex
线程：边界创建Lisp-请求
你好，
我刚刚从上面的帖子中学到了如何平滑地创建边界。
有没有办法通过选定文本的坐标来创建边界？
谢谢 像这样的？
(defun c:BNDTXT (/ pt)
(while (setq pt (cdr (assoc 10 (entget (ssname(ssget "_+.:E:S" '((0 . "TEXT"))) 0)))))
(command "_.-boundary" "_a" "_i" "_n" "" "" "_non" pt "")
)
(princ)
) 还是那样？
(defun c:BNDTXTMULTIPLE (/ pt)
(if (setq ss (ssget '((0 . "TEXT"))))
(repeat (setq in (sslength ss))
(setq pt (cdr (assoc 10 (entget (ssname ss (setq in (1- in)))))))
(command "_.-boundary" "_a" "_i" "_n" "" "" "_non" pt "")
)
)
(princ)
) 尝试：
;;; 2000+ version
;;; Tbox.lsp - Draws boxes around Text, Mtext, Attributes & Dimension Text.
;;; BY: TOM BEAUFORD
;;; tombu@leoncountyfl.gov
;;; LEON COUNTY PUBLIC WORKS ENGINEERING SECTION
;========================================================================
(defun c:tbox (/ *ERROR* thisdrawing EnTyp ENT EnPt SubE SEnTyp Blk BOBJ
elist EOBJ ELA rot of ps AtPt ss tb of ll lr ul ur)
(vl-load-com)
(defun *ERROR* (err) ; define local handler
(princ)
);; "" is the same message you get when exiting an AutoCAD command.
(setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
(setvar "cmdecho" 0)
(setq ENT "Something")
(while ENT
(while(not(or(= EnTyp "ATTRIB")(= EnTyp "ATTDEF")(= EnTyp "TEXT")(= EnTyp "MTEXT")))
(if(not(= EnTyp nil))(prompt "\nEntity Selected not an Attribute or Text"))
(if(setq ENT (entsel "\nSelect Attribute or Text: "))
(setq EnTyp (cdr (assoc 0 (entget (car ENT))))
EnPt (cadr ENT)
ENT (car ENT) ; Entity name
SubE (car (nentselp "" EnPt)) ; SubEntity
SEnTyp (cdr (assoc 0 (entget SubE))) ; SubEntity type
); setq
(setq ENT nil EnTyp nil SEnTyp nil)
); if
(cond
((= SEnTyp "ATTRIB")(setq ENT SubE EnTyp SEnTyp SubE nil SEnTyp nil))
((= EnTyp "DIMENSION")
(progn
(princ "\nEnTyp = Dimension.")
(setq Blk ENT ; Parent entity name
ENT SubE
BOBJ (vlax-ename->vla-object Blk) ; Entity object
EnTyp SEnTyp
SubE nil
SEnTyp nil
); setq
); progn
); EnTyp = "DIMENSION"
(ENT(princ "\nEnTyp is not a Dimension, Insert or Attribute."))
); cond
(setq elist (entget ENT); Entity list
)
(setq EOBJ (vlax-ename->vla-object ENT) ; Entity object
ELA (getvar "clayer") ; Object layer
);;setq
; (if Blk(vlax-dump-object (vlax-ename->vla-object Blk)))
; (vlax-dump-object EOBJ) ; List object properties
(if(acet-layer-locked ELA) ; If object layer's locked
(progn
(prompt(strcat "Current Layer \"" ELA "\" is Locked."))
(setq EnTyp nil) ; continue while loop
)
)
);;while
(setq rot (vlax-get-property EOBJ 'Rotation)
of (vlax-get-property EOBJ 'Height)
ps (vlax-safearray->list(vlax-variant-value (vlax-get-property EOBJ 'InsertionPoint)))
)
(vla-startundomark thisdrawing)
(cond
((= EnTyp "MTEXT")
(progn
(if Blk (setq of (*(vlax-get-property BOBJ 'TextGap)2)))
(setq AtPt (vlax-get-property EOBJ 'AttachmentPoint))
(cond
((or(= 1 AtPt)(= 4 AtPt)(= 7 AtPt))(setqps (polar ps(+ rot PI)(/ of 2))))
((or(= 2 AtPt)(= 5 AtPt)(= 8 AtPt))
(setqps (polar ps(+ rot PI)(/ (+ (cdr(assoc 42 elist))of) 2)))
)
((or(= 3 AtPt)(= 6 AtPt)(= 9 AtPt))
(setqps (polar ps(+ rot PI)(+ (cdr(assoc 42 elist))(/ of 2))))
)
)
(cond
((or(= 1 AtPt)(= 2 AtPt)(= 3 AtPt))(setqps (polar ps(+ rot(/ PI 2))(/ of 2))))
((or(= 4 AtPt)(= 5 AtPt)(= 6 AtPt))
(setqps (polar ps(+ rot(/ PI 2))(/ (+ (cdr(assoc 43 elist))of) 2)))
)
((or(= 7 AtPt)(= 8 AtPt)(= 9 AtPt))
(setqps (polar ps(+ rot(/ PI 2))(+ (cdr(assoc 43 elist))(/ of 2))))
)
)
(setqlr (polar ps rot (+ (cdr(assoc 42 elist))of))
ul (polar ps (- rot(/ PI 2))(+ (cdr(assoc 43 elist))of))
ur (polar lr (- rot(/ PI 2))(+ (cdr(assoc 43 elist))of))
)
(vl-cmdf "pline" "non" ps "non" ul "non" ur "non" lr "c") ;Drawn Box
); progn
); EnTyp = "MTEXT"
((or(= EnTyp "ATTRIB")(= EnTyp "TEXT"))
(progn
(if(= EnTyp "ATTRIB")
(setq
elist(subst(cons 73 (cdr(assoc 74 elist)))(assoc 74 elist)elist)
elist(subst(cons 0 "TEXT")(assoc 0 elist)elist)
)
); if
(vl-cmdf "ucs" "OBject" ENT)
(setq tb (textbox elist)
ll (list(-(car(car tb))(/ of 6))(-(cadr(car tb))(/ of 6)))
ur (list(+(car(cadr tb))(/ of 6))(+(cadr(cadr tb))(/ of 6)))
)
(vl-cmdf "rectang" "non" ll "non" ur) ;Drawn Box
(vl-cmdf "ucs" "p")
); progn
); EnTyp = "ATTRIB" or "TEXT"
); cond
(setq Box (vlax-ename->vla-object (entlast)))
(vl-catch-all-apply 'vla-put-Linetype (list Box "CONTINUOUS"))
(vl-catch-all-apply 'vla-put-ConstantWidth (list Box (/ of 20)))
(setq EnTyp nil SEnTyp nil)
(vla-endundomark thisdrawing)
); while
(princ)
); defun
对它起作用了！
非常感谢！！
现在我可以用这个lisp来找到结构板的边界，
再次感谢。
这个也行！
谢谢你的帮助！
页:
[1]