(defun c:tfit ( / ln pl pt tx )
(and
(setq tx (LM:selectifobject "\nSelect text: " "TEXT"))
(setq pl (LM:selectifobject "\nSelect polyline: " "LWPOLYLINE"))
(setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (= 10 (car x))) (entget pl)))
pl (mapcar '(lambda ( x ) (apply 'mapcar (cons x pl))) '(min max))
tx (entget tx)
)
(entmod
(subst
(cons 40
(*(cdr (assoc 40 tx)) 0.9 ;; Alter this to suit
(apply 'min
(mapcar '/
(apply 'mapcar (cons '- (reverse pl)))
(apply 'mapcar (cons '- (reverse (textbox tx))))
)
)
)
)
(assoc 40 tx) tx
)
)
(setq tx (entget (cdr (assoc -1 tx)))
tb (textbox tx)
vc (mapcar '- (avgpt pl) (mapcar '+ (cdr (assoc 10 tx)) (avgpt tb)))
)
(entmod
(subst (cons 10 (mapcar '+ (cdr (assoc 10 tx)) vc)) (assoc 10 tx)
(subst (cons 11 (mapcar '+ (cdr (assoc 11 tx)) vc)) (assoc 11 tx) tx)
)
)
)
(princ)
)
(defun avgpt ( lst )
((lambda ( len ) (mapcar '/ (apply 'mapcar (cons '+ lst)) (list len len))) (length lst))
)
;; Select if Object-Lee Mac
;; Continuously prompts the user for a selection of a specific object
(defun LM:selectifobject ( msg obj / ent )
(while
(progn (setvar 'errno 0) (setq ent (car (entsel msg)))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= 'ename (type ent))
(if (/= obj (cdr (assoc 0 (entget ent))))
(princ "\nInvalid Object Selected.")
)
)
)
)
)
ent
)
(princ) 这非常有效！非常感谢你。
现在，我尝试扩展这个例程，使其指向对象内部，而不是选择对象，因此它可以处理重叠的对象。想到命令边界：
然而，由于某些原因，脚本没有超出边界命令，它只是停止。知道为什么吗？
非常感谢。 那是一个掌心。。。所有这些命令都在（和…）的内部边界命令返回nil。
这似乎现在起作用了：
如果是tex，则发现一个问题 Can anyone help with angled text?
Thank you. I think I fixed it, thanks Lee Mac for bounding box routine:
(DEFUN c:tfit (/ ln pl pt tx) (AND (SETQ tx (LM:selectifobject "\nSelect text: " "TEXT")); (setq pl (LM:selectifobject "\nSelect polyline: " "LWPOLYLINE")) (SETQ pl (GETPOINT "\nSelect a point: ") ) (tfit (ENTGET tx) pl) ) (PRINC))(DEFUN tfit (tx pl / tb vc x) (SETVAR "cmdecho" 0) (AND tx pl (NOT (COMMAND "-boundary" pl "")) (SETQ pl (ENTLAST)) (SETQ pl (MAPCAR 'CDR (VL-REMOVE-IF-NOT '(LAMBDA (x) (= 10 (CAR x))) (ENTGET pl))) pl (MAPCAR '(LAMBDA (x) (APPLY 'MAPCAR (CONS x pl))) '(MIN MAX)) ) (NOT (COMMAND "_.undo" "")) (ENTMOD (SUBST (CONS 40 (* (CDR (ASSOC 40 tx)) 0.9 ; Alter this to suit (APPLY 'MIN (MAPCAR '/ (APPLY 'MAPCAR (CONS '- (REVERSE pl))) (APPLY 'MAPCAR (CONS '- (REVERSE (_TEXTBOX tx nil)))) ) ) ) ) (ASSOC 40 tx) tx ) ) (SETQ tx(ENTGET (CDR (ASSOC -1 tx))) tb(_TEXTBOX tx nil) vc(MAPCAR '- (avgpt pl) (MAPCAR '+ (CDR (ASSOC 10 tx)) (avgpt tb))) add (MAPCAR '- (CDR (ASSOC 10 tx)) (CAR (_textbox tx T))) ) (ENTMOD (SUBST (CONS 10 (MAPCAR '+ (CDR (ASSOC 10 tx)) vc add)) (ASSOC 10 tx) (SUBST (CONS 11 (MAPCAR '+ (CDR (ASSOC 11 tx)) vc add)) (ASSOC 11 tx) tx) ) ) ) (SETVAR "cmdecho" 1) (PRINC))(DEFUN avgpt (lst) (MAPCAR '/ (APPLY 'MAPCAR (CONS '+ lst)) (LIST 2 2)));; Select if Object-Lee Mac;; Continuously prompts the user for a selection of a specific object(DEFUN LM:selectifobject (msg obj / ent) (WHILE (PROGN (SETVAR 'errno 0) (SETQ ent (CAR (ENTSEL msg))) (COND ((= 7 (GETVAR 'errno)) (PRINC "\nMissed, try again.") ) ((= 'ename (TYPE ent)) (IF (/= obj (CDR (ASSOC 0 (ENTGET ent)))) (PRINC "\nInvalid Object Selected.") ) ) ) ) ) ent);; Selection Set Bounding Box-Lee Mac;; Returns a list of the lower-left and upper-right WCS coordinates of a;; rectangular frame bounding all objects in a supplied selection set.;; s - Selection set for which to return bounding box(DEFUN _textbox (s coords / a b c m n o ll ur) (SETQ a nil b nil m nil n nil ) (SETQ o (VLAX-ENAME->VLA-OBJECT (CDR (ASSOC -1 s)))) (IF (AND o (VLAX-METHOD-APPLICABLE-P o 'getboundingbox) (NOT (VL-CATCH-ALL-ERROR-P (VL-CATCH-ALL-APPLY 'VLA-GETBOUNDINGBOX (LIST o 'a 'b)) ) ) ) (SETQ m (CONS (VLAX-SAFEARRAY->LIST a) m) n (CONS (VLAX-SAFEARRAY->LIST b) n) ) ) (SETQ c(MAPCAR '(LAMBDA (a b) (APPLY 'MAPCAR (CONS a b))) '(MIN MAX) (LIST m n)) ll (CAR c) ur (CADR c) ) (IF (NOT coords) (SETQ c (LIST (LIST 0 0 (NTH 2 (CAR c))) (LIST (ABS (- (CAR ll) (CAR ur))) (ABS (- (CADR ll) (CADR ur))) (NTH 2 (CADR c)) ) ) ) ) c) Hi There
Is it possible to make Lee`s code for mtexts?
Thanks... All of the sudden the last code I posted above stopped working, it now gets error "divide by zero", pointing to
(MAPCAR '/ (APPLY 'MAPCAR (CONS '- (REVERSE pl))) (APPLY 'MAPCAR (CONS '- (REVERSE (_TEXTBOX tx nil)))) )
Any ideas why? divide by 0 error is (drum roll) because you divide by zero!
adding a little surveillance cam like this
(MAPCAR '/ (setq tmp1 (APPLY 'MAPCAR (CONS '- (REVERSE pl)))) (setq tmp2 (APPLY 'MAPCAR (CONS '- (REVERSE (_TEXTBOX tx nil))))) ) which after crash help me retrieve tmp1 and tmp2. Here's what is in them
Command: !tmp1
(0.0 0.0 0.0)
Command: !tmp2
(0.729203 0.242907 0.0)
the mapcar divide the 1rst element of tmp1 by the 1rst element of tmp2 (0.0 / 0.729203)
the mapcar then divide the 2nd element of tmp1 by the 2nd element of tmp2 (0.0 / 0.242907)
the mapcar then divide the 3rd element of tmp1 by the 3rd element of tmp2 (0.0 / 0.0). (bombs here...)
I always had that same values in tmp1/tmp2 no matter the position of of the text. After digging out to understand the code, here'S what I found out. The problem is the boundary command. If if fails to create a boundary, entlast will retrieve something else (in my case the text). a pline will have only 2 sets of coords in assoc 10, so tmp1 has 2 elements, so the 3rd element of tmp2, which is 0 is ignored.
ie: (mapcar '/ '(10 10)'(2 2 0)) returns (5 5)
When boundary fails to be created, in my case the text was selected, which has a set of x y z coords. When it happens, here' what is in PL just before you try to mapcar the division
((226.922 97.1085 0.0) (226.922 97.1085 0.0))
What you could do, get/store the entlast before boundary. After boundary, if the "new" entlast is different the one that you stored, proceed, else you know the boundary creation failed, and could prompt a message before quitting. In my case the boundary being created successfully (creates POLYLINE on top of LWPOLYLINE) , it's for some reason coordinates of it in assoc 10 is (0.0 0.0 0.0)
In fact there is no any coordinates available in that boundary polyline:
((-1 . ) (0 . "POLYLINE") (330 . ) (5 . "196") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0")(100 . "AcDb2dPolyline") (66 . 1) (10 0.0 0.0 0.0) (70 . 1) (40 . 0.0) (41 .0.0) (210 0.0 0.0 1.0) (71 . 0) (72 . 0) (73 . 0) (74 . 0) (75 . 0))
This used to work flawlessly before, there must be some setting I've changed that broke it...
页:
1
[2]