StrikeThrough routine help

[efishe.183349]

I am creating a quick and dirty routine to do a manual pline drawn Strike through of regular dtext entities.

unfortunately I am having difficulty of getting the P1 and P2 points to Extend beyond the text by 1 character and centered in the text based on the alignment.
It works as is for all caps but doesn't extend the full length,

another problem is that when there are lower case characters, such as y,p,q etc. the strike through basis it's positioning on the overall text box.


any suggestions?

(defun C:Strike ( / textent tb ll ur ul lrx1 y1 x2 y2 p1 p2)
(setvar "CMDECHO" 0)
(setq textent (car (entsel "\nSelect text: ")))
(command "UCS" "ENTITY" textent)
(setq tb (textbox (list (cons -1 textent)))
ll (car tb)
ur (cadr tb)
ul (list (car ll) (cadr ur))
lr (list (car ur) (cadr ll))
ofs (* -2)
x1 (car ll)
y1 (cadr ll)
x2 (car lr)
y2 (cadr lr)
x1 (- x1 ofs)
y1 (- y1 ofs)
x2 (+ x2 ofs)
y2 (- y2 ofs)
p1 (list x1 y1)
p2 (list x2 y2)
);setq
;;;use Ltscale as scaling factor.
(command "LAYER" "s" "0" ""
"PLINE" p1 "W" (* (getvar "LTSCALE") 0.0) "" p2 ""
"UCS" "P"
);command
(princ)
);defun
(princ)

[efishe.183349]

got the results I was looking for.
now to just add a
function to
explode mtext, cross out all the lines created from it,
then use that selection set to use txt2mtext

(defun c:STRIKE (/ ang basept BxCoords entLst extend height length ocmd olderr ss txtEnt)
(vl-load-com)
(setq olderr *error*
*error* myerror
ocmd (getvar "cmdecho")
)
(setvar "cmdecho" 0)

(setq ss (ssget "+.:E:S" '((0 . "TEXT")))
)
(defun dtr (a)
(* pi (/ a 180.0))
)
(setq os (getvar "osmode"))
(setvar "osmode" (logior os 16384))
;-----------------------------------------------------------------;
(if ss
(progn
(setq txtEnt (ssname ss 0)
entLst (entget txtEnt)
basePt (cdr (assoc 10 entLst))
BxCoords (textbox (list (cons -1 txtEnt)))
height (cdr (assoc 40 entLst))
extend (* height 0.15)
length (caadr bxcoords)
ang (cdr (assoc 50 entLst))
basept (mapcar '- basept (list extend 0 0))
)
(command "LAYER" "s" "Display_Note_R" "" "pline" (polar basept (+ (dtr 90) ang)(/ height 2))(polar (getvar "lastpoint") ang (+ length extend extend)) "")
) ;
) ;
;----------------------------------------------------------------;
(setq *error* olderr) ;resets error
(setvar "cmdecho" ocmd)
(setvar "osmode" os) ;resest osnaps if they were turned off back on
(princ) ;no nil at end of program.
) ;end defun.

[RobertB]

BTW, that's a pretty old-school way of treating the error handler. Not to mention that the redefined error handler is not even there (presuming you elected to not post it).

Here is the approach many starting using once AutoCAD 2000 was released:

(defun MyExit (msg)
(cond
((not msg)) ; no error, normal exit
((member msg '("Function cancelled" "quit / exit abort"))) ; <esc> or (quit)
((princ (strcat "\nError: " msg)))) ; error, display it
;| any other code for needed cleanup |;
(princ))

(defun C:MainCode (/ *Error*) ; localize error handler
(setq *Error* MyExit) ; redefine local error handler
;| rest of the main code |;
(MyExit nil)) ; normal, clean exit

This works because once AutoCAD 2000 came out, when a localized error handler runs, it remains local. Prior to 2000, when a localized error handler ran it would become global, overwriting the original global error handler. That is where the save old, set new, restore old approach came from. There is no need for that any longer.

The other advantage to this later approach is that you need to write the clean code only once. The MyExit function can act in both an error situation or a normal exit, as long as you handle the msg argument as being nil in a normal exit.