Leaderboard

What do you want this new point for? What are you going to do with it? This may help me determine the logic needed to get the correct point as it is probably going to be easier to calculate this point instead of offsetting the xline and finding an intersection. Will look at this again at lunch time, work calls

My pleasure. I think I know what you are after and why. Could you upload a small sample drawing of before and after. I did notice that some of the blocks were mirrored so accounting for this may make it slightly more difficult

You'll need to escape the double-quotes, i.e. (setq loc_sys " ;Start of value for variable 15000.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.00.0 unknow0=)94uv}@<>2&92<k4$-.\"l,Z?eIAVy4$-.\"l)[AUIAV4$-.\"l)[/UIA4$-.\"l*J/UIzey\" W000022402200.00.02.40855436775217460.0-5862800.0500000.00.00.00.00.00.00.00.00.00.00.00.00.01.00.0.000.0 false0truetrue0.00.00.00.00.00.00.00.00.00.0.00.00.01.01.722-98.0596.2831752114194910.99998390891079565.598554528. 340.00.00.01.00.00.00.00.00.00.00.00.00.00.0-12.256-19.618-107.1391097836.266554755.6920.00.00.00.00.0003end " ;End of value for variable ); end of setq But it's a really odd value.

OK. Try this. (defun rh:sammlung_n (o_lst grp / tmp n_lst) (setq n_lst nil) (cond ( (and o_lst (= (rem (length o_lst) grp) 0)) (while o_lst (repeat grp (setq tmp (cons (car o_lst) tmp) o_lst (cdr o_lst))) (setq n_lst (cons (reverse tmp) n_lst) tmp nil) );end_while ) );end_cond (if n_lst (reverse n_lst)) );end_defun (vl-load-com) (defun c:layerElev ( / c_doc c_lyrs ss clyr cnt pl_obj p_lst elev lyr_txt) (setq c_doc (vla-get-activedocument (vlax-get-acad-object)) c_lyrs (vla-get-layers c_doc) clyr (getvar 'clayer) );end_setq (prompt "\nSelect Polylines : ") (setq ss (ssget '((0 . "*POLYLINE")))) (cond (ss (repeat (setq cnt (sslength ss)) (setq pl_obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt))))) (cond ( (vlax-property-available-p pl_obj 'elevation) (setq elev (vlax-get pl_obj 'elevation))) ;;LWPolylines Polylines and 2DPolylines (t (setq p_lst (rh:sammlung_n (vlax-get pl_obj 'coordinates) 3) elev (caddr (car p_lst)) );end_setq ) );end_cond (cond ( (< elev 700.0) (setq lyr_txt "NO_ELEV")) ( (= (rem (fix elev) 2) 1) (setq lyr_txt (strcat "CONTOUR_EL" (itoa (1+ (fix elev)))))) (t (setq lyr_txt (strcat "CONTOUR_EL" (itoa (fix elev))))) );end_cond (if (not (tblsearch "layer" lyr_txt)) (vla-add c_lyrs lyr_txt)) (vlax-put-property pl_obj 'layer lyr_txt) );end_repeat ) );end_cond (setvar 'clayer clyr) (princ) );end_defun This has been minimally test, and utilises some visual lisp hence the inclusion of (vl-load-com). It works in my small scale test. There is no local error sub.

I have this alternative that avoids copying the original, but assumes that the mid point of the block is the mid point of the line. I have changed the the routine name to BPER2 so you will need to type this instead of TEST on the command line. It is tested and seems to do exactly the same as the previous one, and should be faster. (defun rh:gbbc (obj / ll ur lst c_pt) (if (and obj (= (type obj) 'ENAME)) (setq obj (vlax-ename->vla-object obj))) (cond (obj (vlax-invoke-method obj 'getboundingbox 'll 'ur) (setq lst (mapcar 'vlax-safearray->list (list ll ur)) c_pt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (car lst) (cadr lst)) );end_setq ) );end_cond c_pt );end_defun (defun rh:sammlung_n (o_lst grp / tmp n_lst) (setq n_lst nil) (cond ( (and o_lst (= (rem (length o_lst) grp) 0)) (while o_lst (repeat grp (setq tmp (cons (car o_lst) tmp) o_lst (cdr o_lst))) (setq n_lst (cons (reverse tmp) n_lst) tmp nil) );end_while ) );end_cond (if n_lst (reverse n_lst)) );end_defun (vl-load-com) (defun c:bper2 ( / *error* c_doc c_spc l_obj ent e_lst ss cnt obj s_pt m_pt e_pt x_obj x_pts s_d d_lst x_pt) (defun *error* ( msg ) (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error occurred : " msg))) (princ) );end_defun *error* (setq c_doc (vla-get-activedocument (vlax-get-acad-object)) c_spc (vlax-get-property c_doc (if (= 1 (getvar 'cvport)) 'paperspace 'modelspace)) );end_setq (while (not l_obj) (setq ent (car (entsel "\nSelect Line : ")) e_lst (entget ent) );end_setq (if (vl-position (cdr (assoc 0 e_lst)) (list "ARC" "LINE" "LWPOLYLINE" "RAY" "SPLINE" "XLINE")) (setq l_obj (vlax-ename->vla-object ent))) );end_while (if (and (princ "\nSelect Bars : ")(setq ss (ssget ":L" '((0 . "INSERT")(2 . "`*U*"))))) (repeat (setq cnt (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq cnt (1- cnt)))) s_pt (vlax-get obj 'insertionpoint) m_pt (rh:gbbc obj) e_pt (polar s_pt (angle s_pt m_pt) (* (distance s_pt m_pt) 2.0)) x_obj (vlax-invoke c_spc 'addxline s_pt e_pt) x_pts (rh:sammlung_n (vlax-invoke x_obj 'intersectwith l_obj acextendnone) 3) s_d 1.0e200 d_lst nil );end_setq (vla-delete x_obj) (foreach x_pt x_pts (if (< (setq d (distance x_pt s_pt)) s_d) (setq s_d d d_lst (list s_pt x_pt))) (if (< (setq d (distance x_pt e_pt)) s_d) (setq s_d d d_lst (list e_pt x_pt))) );end_foreach (vlax-invoke obj 'move (car d_lst) (cadr d_lst)) );end_repeat );end_if (princ) );end_defun