Jump to content

Block Base Point Problem


Recommended Posts

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

  • 2 years later...

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 by Tiger
added code tags
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...