Block Base Point Problem

[ivannnn]

Hi i need help.

 

I want to move the base point of a block in the block editor. However, when I move it, the block moves accordingly in the drawing.

 

How can i move the base point in the editor, so that the block stays at the same position in the drawing.

 

tnx

[ReMark]

Please do not double post. Thank you.

[lpseifert]

Maybe someone can prove me wrong but I don't think there is a way.

[dbroada]

unless 2009 has brought in an enhancement, I agree with lpseifert.

 

This is why it is so important to specify the correct base point when defining your blocks.

[EMS_0525]

type in BASE in the drawing of the block

[dbroada]

type in BASE in the drawing of the block

which will move the base in exactly the way the OP doesn't want it to.

[wannabe]

Hi i need help.

 

I want to move the base point of a block in the block editor. However, when I move it, the block moves accordingly in the drawing.

 

How can i move the base point in the editor, so that the block stays at the same position in the drawing.

 

tnx

 

Draw a line from the old point to where the new one will be. Once you've redefined the base point, move all the other objects back along the temporary line you created.

 

Sounded a bit simple. Have I correctly inferred you requirements?

[ivannnn]

yeah i guess i can do that... its not an elegant soulution but hey...

[grandhougday]

this lisp works perfect:

 

(defun c:bnpt ( / en p1 p2 a d bn)
(cond
((not (setq en (f:entselx 
"INSERT" "\nSelect Insert to reposition insertion point: "))))
((not (setq p2 
(getpoint (setq p1 (f:assoc 10 (setq en (car en)))) "\nNew position for 
insertion point: "))))
(T
(setq p2 (f:insert_trans en p2)
a (angle p2 
p1)
d (distance p2 p1)
p1 (ftx p1)
p2 (ftx p2)
bn (f:assoc 2 
en)
);setq
(vlax-map-Collection (f:vltblobjname 'Blocks bn 
nil)
'(lambda (e)
(vla-Move e p2 p1)
)
)
(f:map_all:filter (list 
(cons 0 "INSERT")(cons 2 bn))
(lambda (e)
(vla-Move e (ftx 
(f:insert_polar e a d)) (vla-get-InsertionPoint 
e))
)
)
)
)
(princ));defun

(setq #000 (list 0.0 0.0 
0.0))
(setq #000x (vlax-3d-point (list 0.0 0.0 0.0)))

(defun f:entselx 
(typ prm / e ini)
(if (listp prm)(setq ini (cadr prm) prm (car 
prm)))
(setvar "ERRNO" 0)
(while (and (not e) (/= (getvar "ERRNO") 
52))
(if ini (initget ini))
(setq e (entsel prm))
(cond
((= (type e) 
'STR))
((/= (f:assoc 0 (car e)) typ)
(setq e 
nil)
)
);cond
)
e)

(defun f:en (en)
(if (/= (type en) 
'ENAME)
(vlax-vla-object->ename en)
en
)
)

(defun f:enx 
(en)
(if (= (type en) 'ENAME)
(vlax-ename->vla-object 
en)
en
)
)


(defun f:assoc (at lst / ret)
(cond
((= 
(type lst) 'ENAME)(setq lst (entget lst)))
((= (type lst) 'VLA-OBJECT)(setq 
lst (entget (f:en lst))))
)
(if (and (f:assocp lst)
(setq ret (assoc at 
lst))
);and
(cdr ret)
);if
)

(defun f:assocp 
(lst)
(and
lst
(listp lst)
(not (vl-some '(lambda (at) (not 
(vl-consp at))) lst))
)
)

(defun f:insert_trans (en pt / 
p)
(setq p (f:assoc 10 en)
pt (polar #000 (- (angle p pt) (f:assoc 50 en)) 
(distance p pt))
pt (list (/ (car pt) (f:assoc 41 en)) (/ (cadr pt) (f:assoc 
42 en)) (/ (caddr pt) (f:assoc 43 en)))
);setq
(polar p (angle #000 pt) 
(distance #000 pt))
)

(defun f:insert_polar (en a d / pt)
(setq pt 
(polar #000 a d)
pt (list (* (f:assoc 41 en) (car pt)) (* (f:assoc 42 en) 
(cadr pt)) (* (f:assoc 43 en) (caddr pt)))
)
(polar (f:assoc 10 en) (+ 
(angle #000 pt) (f:assoc 50 en)) (distance #000 pt))
)

(defun ftx 
(pt)
(if (= (type pt) 'variant)
pt
(vlax-3d-point 
pt)
)
)

(defun f:vltblobjname (tbl nam doc)
(if (not doc)(setq 
doc (fx:doc)))
(if (and
(= (type doc) 
'VLA-OBJECT)
(vlax-property-available-p doc tbl)
);and
(f:vlerr 
'vla-Item (list (vlax-get-property doc tbl) nam) nil)
)
)

(defun 
fx:acad ()
(setq 
*AutoCAD-application-object*
(cond
(*AutoCAD-application-object*)
((vlax-get-acad-object))
(T 
nil)
)
)
)

(defun fx:doc ()
(setq 
*active-document*
(cond
(*active-document*)
((vla-get-ActiveDocument 
(fx:acad)))
(T nil)
)
)
)

(defun f:vlerr (fun lst tag / 
ret)


(if (vl-catch-all-error-p (setq ret (vl-catch-all-apply fun 
lst)))
(if tag
(progn (strcat "\n" (vl-catch-all-error-message ret)) 
nil)
nil
)
(if (not ret) (setq ret T) ret)
)
(if (= (type ret) 
'VL-CATCH-ALL-APPLY-ERROR) (setq ret nil))


ret)

(defun 
f:map_all:filter (filt :fun / ret)
(if (setq ss (ssget "_X" 
filt))
(progn
(mapcar (function (lambda (e)
(setq ret (append ret (list 
(:fun (f:enx e)))))
))
(f:sstolst 
ss)
);mapcar
);progn
);if


(vlax-map-Collection 
(vla-get-Blocks (fx:doc))
(function (lambda (b)
(if (and
(= 
(vla-get-IsLayout b) :vlax-false)
(= (vla-get-IsXRef b) :vlax-false)
(not 
(wcmatch (vla-get-Name b) "*|*"))
);and
(vlax-map-Collection 
b
(function (lambda (e)
(if (f:apply_ssfilter e filt)
(setq ret (append 
ret (list (:fun 
e))))
);if
))
);map
);if
));function
);map
ret
)

(defun 
f:sstolst (ss / lst i l)
(if ss (progn
(setq l (sslength ss) i 
0);setq
(while (< i l)
(setq lst (append lst (list (ssname ss i))) i 
(1+ i))
);while
));progn if
lst
)

(defun f:apply_ssfilter (en 
lst / ret val typ)
(setq ret T en (f:en en))
(mapcar '(lambda (at)
(if 
ret
(cond
((= (car at) 0)
(if (not (wcmatch (setq typ (strcase (f:assoc 
0 en))) (strcase (cdr at))))
(setq ret nil)
)
);0
((member (car at) 
(list 8 2));layer or blockname
(if (not (and (= (car at) 2) (/= typ 
"INSERT")))
(if (not (wcmatch (strcase (f:assoc (car at) en)) (strcase (cdr 
at))))
(setq ret nil)
)
)
);layer blockname
((= (car at) 
-3)
(if (not (assoc -3 (entget en (cadr at))))
(setq ret 
nil)
)
);xdata appid - this will not work in a dbx dwg
((setq val 
(f:assoc (car at) en))
(setq ret (= val (cdr at)))
)
(T (setq ret 
nil))
);cond
);if
)
lst
)
ret
)

i found it herehttp://forums.autodesk.com/t5/AutoCAD-2008/change-base-point-of-a-block/m-p/2458376/highlight/true

Edited August 8, 2011 by Tiger
added code tags