TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Mark on March 23, 2005, 08:07:50 AM
-
Create a circle at the insertion point of each TEXT entity in a selection set, the circle will be 6% of the text height. Filter the selection so that it only contains TEXT with a "middle center" justification.
Possible pseudo code;
prompt user to create selection set
iterate through selection set creating a circle at each insertion point.
There is no time limit, let's see what you have. Bonus points for creativity.
-
Would this do?
(defun c:TxtCircle (/ ss1 Count CrclRad CrclPnt Oldosmode OldEcho)
(setq Count 0
Oldosmode (getvar "OSMODE")
OldEcho (getvar "CMDECHO"))
(setvar "OSMODE" 0)
(setvar "CMDECHO" 0)
(setq ss1 (ssget "X" '((0 . "TEXT")(72 . 1)(73 . 2))))
(if (/= ss1 nil)(progn
(while (< Count (sslength ss1))
(setq CrclRad (* (cdr (assoc 40 (entget (ssname ss1 count)))) 0.06))
(setq CrclPnt (cdr (assoc 11 (entget (ssname ss1 count)))))
(command "._Circle" CrclPnt CrclRad)
(setq Count (+ Count 1))
)))
(setvar "OSMODE" OldOsmode)
(setvar "CMDECHO" OldEcho)
(princ)
)
BTW: NO copyright on this code! :D
-
- Jimmy D
Second post here @theswamp and it's to a challange!! You're well on your way to becoming a regular here *grin*
Would this do?
Yep. Only I would let the user select the entities, but that's minor.
You might also want to use the bbcode tag "code". Here's how;
click on the button "Code", then paste/type in your text, then hit the button again. See also "First things first".
-
Sorry about the "code" thing Mark. :oops:
This is the corrected code:
(defun c:TxtCircle (/ ss1 Count CrclRad CrclPnt Oldosmode OldEcho)
(setq Count 0
Oldosmode (getvar "OSMODE")
OldEcho (getvar "CMDECHO")
)
(setvar "OSMODE" 0)
(setvar "CMDECHO" 0)
(princ "\nSelect text objects... ")
(setq ss1 (ssget '((0 . "TEXT") (72 . 1) (73 . 2))))
(if (/= ss1 nil)
(progn
(while (< Count (sslength ss1))
(setq CrclRad (* (cdr (assoc 40 (entget (ssname ss1 count)))) 0.06))
(setq CrclPnt (cdr (assoc 11 (entget (ssname ss1 count)))))
(command "._Circle" CrclPnt CrclRad)
(setq Count (+ Count 1))
)
)
)
(setvar "OSMODE" OldOsmode)
(setvar "CMDECHO" OldEcho)
(princ)
)
-
The preview was OK, I swear!! :cry:
[/code]
-
Not a big deal, just helps when reading the code. What happened was you use the "code" tag in your response, as in "Sorry about the "code" thing" without a closing tag. Anyway....... I fixed for ya.
-
Jimmy
Nice one, very good work...
-
OK, here is my attempt.
(defun c:TxtC (/ ss elst)
(prompt "\nSelect text objects... <exit> ")
(and (setq ss (ssget '((0 . "TEXT") (72 . 1) (73 . 2))))
(repeat (sslength ss)
(setq elst (entget (ssname ss 0)))
(entmake (list '(0 . "CIRCLE")
(cons 10 (cdr (assoc 11 elst)))
(cons 40 (* (cdr (assoc 40 elst)) 0.06))
)
)
(ssdel (ssname ss 0) ss)
)
)
(princ)
)
-
Just had to make ^that semi-recursive
(defun C:TXTC (/ makeCircle)
(defun makeCircle (ss / el e)
(and ss (> (sslength ss) 0)
(setq el (entget (setq e (ssname ss 0))))
(entmake (list '(0 . "CIRCLE")
(cons 10 (cdr (assoc 11 el)))
(cons 40 (* (cdr (assoc 40 el)) 0.06)))
)
(makeCircle (ssdel e ss))
)
)
(command "UNDO" "Begin")
(makeCircle (ssget '((0 . "TEXT") (72 . 1) (73 . 2))))
(command "UNDO" "End")
(princ)
)
-
Is it considered cheating if you use the Express Tools' TCIRCLE command? :D
(Actually, that may be harder than some of the stuff already posted... :lol: )
-
Mark didn't post any rules so I guess anything goes! :)
-
I took a simpler approach. :D
(defun c:cctxt (/
; local functions
make-circle get-text-size get-ins-point
; local varibles
ss cntr ent
)
(defun make-circle (inst_pt radius)
(entmake
(list
'(0 . "CIRCLE")
(cons 10 inst_pt)
(cons 40 radius)
)
)
)
(defun get-text-size (ent)
(cdr (assoc 40 (entget ent)))
)
(defun get-ins-point (ent)
(cdr (assoc 11 (entget ent)))
)
;; =============== main starts here =================
(setq ss (ssget
'(
(-4 . "<and")
(0 . "TEXT")
(72 . 1) ; justification - center
(73 . 2) ; middle
(-4 . "and>")
)
)
)
(if (and ss (> (sslength ss) 0))
(progn
(setq cntr 0)
(while (setq ent (ssname ss cntr))
(make-circle
(get-ins-point ent)
(* (get-text-size ent) 1.06)
)
(setq cntr (1+ cntr))
)
)
; else
(alert "No text found!!")
)
(princ)
)
made a slight revision concerning the radius size
revision 2, changed the IF statement (thanks CAB)
-
Very quick crud ...
(defun c:crud ( / foo main )
(defun foo ( ename / data )
(vl-catch-all-apply
'(lambda ()
(vla-addcircle
(vlax-ename->vla-object
(cdr
(assoc 330
(setq data (entget ename))
)
)
)
(vlax-3d-point
(cdr
(assoc 10 data)
)
)
(* 0.03
(cdr
(assoc 40 data)
)
)
)
)
)
)
(defun main ( / ss i )
(if (setq ss (ssget "x" '((0 . "text")(72 . 1)(73 . 2))))
(repeat (setq i (sslength ss))
(foo (ssname ss (setq i (1- i))))
)
)
(princ)
)
(main)
)
-
You just keep writing that "crud", I'm starting to catch-on!! :D
-
WOW!!! Five very different routines, and all five (actually Jimmmy's two make six) work "a treat"! Nice, fellas!
-
Thanks Mark, signed crudster.
:)
-
Mark,
I've noticed that you multiply (* txtheight 1.06).
This means the circle will be 106% instead of 6%!
Jimmy
-
Yea that's what I meant in my original post, 6% larger than the text size. Of course that's not what I said. :D
-
Oh sure!
:)