;;;图块基点修改 ,但图块实际位置保持不变
;;;明经通道 编制 By Gu_xl 2011年7月
(defun c:CBB () (c:BlockBase))
(defun c:BlockBase (/ loop base)
(while (and
(setq en (car (entsel "\n 选择一个图块:" )))
(= "INSERT" (cdr (assoc 0 (entget en))))
)
(setq base (cdr (assoc 10 (entget en))))
(sssetfirst nil (ssadd en))
(setq pt (getpoint base "\n 图块新基点"))
(if pt (gxl-BlockBaseEdit en pt))
;(sssetfirst)
)
)
(defun gxl-BlockBaseEdit (InsertEName newInsPt1
/ BlockToInsertXform
InsertToBlockXform
BlockToInsertSetup
VectorCrossProduct
3DTransformAB 3DTransformBA
blks LOOP
sel BlockName
blkdef oldInsPt1
oldInsPt2 newInsPt2
ss idx
XformSpec atts att *ACDOCUMENT*
)
(setq *ACDOCUMENT* (vla-get-ActiveDocument (vlax-get-acad-object)))
;;;子程序
(defun BlockToInsertXform (P1 TransformSpec)
(3dTransformAB
(nth 0 TransformSpec)
(nth 1 TransformSpec)
(nth 2 TransformSpec)
(nth 3 TransformSpec)
(nth 4 TransformSpec)
P1
) ;_ end 3dTransformAB
) ;_ end defun
(defun InsertToBlockXform (P1 TransformSpec)
(3dTransformBA
(nth 0 TransformSpec)
(nth 1 TransformSpec)
(nth 2 TransformSpec)
(nth 3 TransformSpec)
(n