Can anyone convert this lisp routine in to a workable version for Autocad
2004. It use to work in 14. Very handy for doing lease drawings.
Thanks for any help,
Ed
(defun C:OPM;;;AREA:PEDIT:STRETCH:SITE Offsetting stretch one side of a
Pline to mid point of a line perpendicular
( / a b c d e f g h i j k u v)
(command".ucs""w")
(while(m:op1)
(setvar"osmode"128)
(setvar"lastpoint"(setq EPT(osnap EPT"nea")))
(setq a(getpoint EPT" midpoint between PER to: ")
b(inters a EPT e f nil)
a(polar b(angle b a)(/(distance b a)2))
)
(setvar"osmode"0)
(m:op2)
)
(prin1)
)

What you show doesn't require any changes. But without seeing the called
subroutines m:op1 and m:op2, it's impossible to tell what it's supposed to
do, or how it does it. (You *do* have those routines loaded, I hope? If not,
that alone could be your problem.)
___

Thanks for taking a look.
I believe I found the whole orig. routine.
;feature -- looks behind and ahead for other vertexes on same axis,
;since many fac man packages include tracing functions that draw another
;vertex at each side of a door jamb
;but we want this to treat a whole wall, even if broken by a door, as being
;between two vertexes
;feature -- works on angled walls, to look at the next or prior leg,
;and stretch along its axis, a distance equal to the hypotenuese of
;any triagle formed
;FUTURE -- to add an undo feature ;; hangup is (entget..), which has no
;susceptibility to (initget...), and AutoCAD refuses to fix this ;; requires
;making operator state a desire to continue or undo, then picking another,
;instead of a sensible process of either picking another or undoing
; **** COMMANDS ****
;Offsetting stretch one side of a Pline, to mid point of a line
perpendicular
(defun C:OPM( / a b c d e f g h i j k) ; u v
(varget)
(command"ucs""w");this is just too much trouble to avoid
(while t
(m:op1)
(setvar"osmode"128)
(setvar"lastpoint"(setq EPT(osnap EPT"nea")))
(setq a(getpoint EPT" midpoint between PER to: ")
b(inters a EPT e f nil)
a(polar b(angle b a)(/(distance b a)2))
)
(setvar"osmode"0)
(m:op2)
)
)
;Offsetting stretch one side of a Pline, to a line perpendicular
(defun C:OPP( / a b c d e f g h i j k) ; u v
(varget)
(command"ucs""w")
(while t
(m:op1)
(setvar"osmode"128)
(setvar"lastpoint"(setq EPT(osnap EPT"nea")))
(setq a(getpoint EPT" PER to: ")
)
(setvar"osmode"0)
(m:op2)
)
)
;Offsetting stretch one side of a Pline, without getting all entities,
;just the pline - preset distance, most like offset command
(defun C:OP( / a b e f g h i j k); c d u v
(setq D:OFD(defdist"\nOffset\nOffset distance"D:OFD))
(varget)
(command"ucs""w")
(while t
(m:op1) ;sets values of EPT, e, f, g, u, and v
(setvar"snapbase"(list(car EPT)(cadr EPT)))
(setvar"snapunit"'(2000.0 1.0))
(setvar"snapmode"1)
(setvar"snapang"(angle e f))
(initget 1)
(setq a(getpoint EPT" Side to offset?")
b(angle EPT a)
b(if(equal b(* 2 pi)0.001)0 b)
a(polar EPT b D:OFD)
)
(setvar"snapunit"SU_V)
(m:op2) ;uses a, e, f, g, u, and v
)
)
; **** BASE FUNCTIONS ****
;base function for selecting one side of pline
(defun M:OP1( / c) ;h i j k
(while(not(="VERTEX"(lstnent"\nPick polyline side")))(prompt" Not
polyline."))
(setq e(cdrass 10) ;the leading vertex of side selected
f(cdr(assoc 10(entget(entnext ENT))))
;next vertex, but nil if pline
;is closed & side selected was the closer
c(while(/="SEQEND"(cdr(assoc 0(setq d(entget(setq ENT(entnext ENT))))))))
;finding database of parent entity
ENT(cdr(assoc -2 d))
ELST(entget ENT)
h(d:plpo) ;this lists all of the points in a pline
f(if f f(car h)) ;if no next point, because closed, use start point
;here the checking occurs for coaxial vertices before e and after f
i(length h)
j(- i(length(member e h))) ;position indicator of point e
k(1+ j) ; " " " " f
)
;e, searching backwards (and looping back to start, if necessary)
(while(and(>= j 0)
(inters(nth j h)(nth j h)e f nil) ;this will be true if coaxial
)
(setq e(nth j h)
j(if(and(= 0 j)
(member(car h)(cdr h)) ;this is closed pline
)
(1- i)
(1- j)
)
)
)
(setq u(if(= -1 j)nil(nth j h))) ;this is point before e - need for
;angle calc of this side, or nil if
;e is start of unclosed pline
;f, searching forward (and looping back to end, if necessary)
(while(and(

PolyTech Forum website is not affiliated with any of the manufacturers or service providers discussed here.
All logos and trade names are the property of their respective owners.