修改图块基点（已解决）

仲文玉 · 发表于 2011-4-20 15:43:45

本帖最后由仲文玉于 2011-7-6 15:34 编辑

求助各位大侠，小弟遇到个问题：
   原来同事做的图里面的块基点都是瞎弄的，用图块替换工具全部跑位了。想要个不重新炸开再做快，能够直接更改原有图块基点的程序！
   谢谢

   感谢各位的热心帮助

该贴已经同步到仲文玉的微博

Gu_xl · 发表于 2011-7-5 20:04:14

本帖最后由 Gu_xl 于 2011-7-6 15:49 编辑

与Lee Mac不同，图块基点修改，但图块实际位置保持不变

;;;图块基点修改，但图块实际位置保持不变
;;;明经通道编制 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)
(nth 4 TransformSpec)
P1
) ;_ end 3dTransformBA
) ;_ end defun
(defun BlockToInsertSetup (InsertEname / InsertEList
ZAxis NCSXAxis InsertAngle
)
(if (= 'str (type InsertEName))
(progn
(setq InsertEName
(vlax-vla-object->ename
(vla-Item blks InsertEName)
) ;_ vlax-vla-object->ename
) ;_ setq
(list '(1 0 0)
'(0 1 0)
'(0 0 1)
(GXL-NUM-AX->LISPVALUE
(vla-get-Origin (vlax-ename->vla-object InsertEName))
) ;_ GXL-NUM-AX->LISPVALUE
'(1 1 1)
) ;_ list
) ;_ progn
(progn
(setq ZAxis (GXL-NUM-AX->LISPVALUE (vla-get-Normal InsertEname))
InsertAngle (vla-get-Rotation InsertEname)
NCSXAxis (trans (list (cos InsertAngle) (sin InsertAngle) 0.0)
ZAxis
0
) ;_ end trans
) ;_ end setq
(list
NCSXAxis
(VectorCrossProduct ZAxis NCSXAxis)
ZAxis
(trans
(GXL-NUM-AX->LISPVALUE (vla-get-InsertionPoint InsertEname))
ZAxis
0
) ;_ trans
(list (vla-get-XScaleFactor InsertEname)
(vla-get-YScaleFactor InsertEname)
(vla-get-ZScaleFactor InsertEname)
) ;_ end list
) ;_ end list
) ;_ progn
) ;_ if
) ;_ end defun
(defun VectorCrossProduct (InputVector1 InputVector2)
(list (- (* (cadr InputVector1) (caddr InputVector2))
(* (cadr InputVector2) (caddr InputVector1))
) ;_ end -
(- (* (caddr InputVector1) (car InputVector2))
(* (caddr InputVector2) (car InputVector1))
) ;_ end -
(- (* (car InputVector1) (cadr InputVector2))
(* (car InputVector2) (cadr InputVector1))
) ;_ end -
) ;_ end list
) ;_ end defun
(defun 3DTransformAB (XA YA ZA OA SA P1 /)
(setq P1 (mapcar '* P1 SA))
(mapcar '+
OA
(list (+ (* (car XA) (car P1))
(* (car YA) (cadr P1))
(* (car ZA) (caddr P1))
) ;_ end +
(+ (* (cadr XA) (car P1))
(* (cadr YA) (cadr P1))
(* (cadr ZA) (caddr P1))
) ;_ end +
(+ (* (caddr XA) (car P1))
(* (caddr YA) (cadr P1))
(* (caddr ZA) (caddr P1))
) ;_ end +
) ;_ end list
) ;_ end mapcar
) ;_ end defun
(defun 3DTransformBA (XA YA ZA OA SA P1 /)
(setq P1 (mapcar '- P1 OA))
(mapcar '/
(list (+ (* (car XA) (car P1))
(* (cadr XA) (cadr P1))
(* (caddr XA) (caddr P1))
) ;_ end +
(+ (* (car YA) (car P1))
(* (cadr YA) (cadr P1))
(* (caddr YA) (caddr P1))
) ;_ end +
(+ (* (car ZA) (car P1))
(* (cadr ZA) (cadr P1))
(* (caddr ZA) (caddr P1))
) ;_ end +
) ;_ end list
SA
) ;_ end mapcar
) ;_ end defun
;主程序
(setq blks (vla-get-blocks *ACDOCUMENT*))
(if (= 'str (type InsertEName))
(progn
(setq XformSpec (BlockToInsertSetup InsertEName)
BlockName InsertEName
) ;_ setq
(setq InsertEName (vla-Item blks InsertEName))
(setq
oldInsPt1 (GXL-NUM-AX->LISPVALUE (vla-get-Origin InsertEName))
) ;_ setq
) ;_ progn
(progn
(if (= 'ename (type InsertEName))
(setq InsertEName (vlax-ename->vla-object InsertEName))
)
(setq oldInsPt1 (GXL-NUM-AX->LISPVALUE
(vla-get-InsertionPoint InsertEName)
)
BlockName (vla-get-name InsertEName)
XformSpec (BlockToInsertSetup InsertEName)
) ;_ setq
) ;_ progn
) ;_ if
(setq oldInsPt2 (InsertToBlockXform oldInsPt1 XformSpec)
newInsPt2 (InsertToBlockXform newInsPt1 XformSpec)
) ;_ setq
(setq blkdef (vla-item blks BlockName))
(vlax-for obj blkdef
(vla-move obj
(vlax-3d-point newInsPt2)
(vlax-3d-point oldInsPt2)
) ;_ vla-move
) ;_ vlax-for
;;;修改块定义基点
(vlax-for blk blks
(vlax-for obj blk
(cond ((and (= "AcDbBlockReference" (vla-get-ObjectName obj))
(= (strcase BlockName) (strcase (vla-get-name obj)))
) ;_ and
(setq XformSpec (BlockToInsertSetup obj))
(setq oldInsPt1 (BlockToInsertXform oldInsPt2 XformSpec)
newInsPt1 (BlockToInsertXform newInsPt2 XformSpec)
) ;_ setq
(vla-move obj
(vlax-3d-point oldInsPt1)
(vlax-3d-point newInsPt1)
) ;_ vla-move
(if (setq atts (GXL-NUM-AX->LISPVALUE (vla-GetAttributes obj)))
(foreach att atts
(vla-move att
(vlax-3d-point newInsPt1)
(vlax-3d-point oldInsPt1)
)
)
)
)
((and (= "AcDbMInsertBlock" (vla-get-ObjectName obj))
(= (strcase BlockName) (strcase (vla-get-name obj)))
) ;_ and
(setq XformSpec (BlockToInsertSetup obj))
(setq oldInsPt1 (BlockToInsertXform oldInsPt2 XformSpec)
newInsPt1 (BlockToInsertXform newInsPt2 XformSpec)
) ;_ setq
(vla-move obj
(vlax-3d-point oldInsPt1)
(vlax-3d-point newInsPt1)
) ;_ vla-move
(if (setq atts (GXL-NUM-AX->LISPVALUE (vla-GetAttributes obj)))
(foreach att atts
(vla-move att
(vlax-3d-point newInsPt1)
(vlax-3d-point oldInsPt1)
)
)
)
)
) ;_ cond
) ;_ vlax-for
) ;_ vlax-for
(vla-regen *ACDOCUMENT* acActiveViewport)
)
(defun gxl-Num-AX->LispValue (v)
(cond ((= (type v) 'variant) (gxl-Num-AX->LispValue (vlax-variant-value v)))
((= (type v) 'safearray)
(mapcar 'gxl-Num-AX->LispValue (safearray-value v))
)
((= (type v) 'list)
(mapcar 'gxl-Num-AX->LispValue v)
)
(T v)
)
)

;;;图块基点修改 ，但图块实际位置保持不变 
;;;明经通道 编制 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) 
      (nth 4 TransformSpec) 
      P1 
    ) ;_ end 3dTransformBA 
  ) ;_ end defun 
  (defun BlockToInsertSetup (InsertEname   /   InsertEList 
        ZAxis    NCSXAxis  InsertAngle 
       ) 
    (if (= 'str (type InsertEName)) 
      (progn 
(setq InsertEName 
        (vlax-vla-object->ename 
   (vla-Item blks InsertEName) 
        ) ;_ vlax-vla-object->ename 
) ;_ setq 
(list '(1 0 0) 
       '(0 1 0) 
       '(0 0 1) 
       (GXL-NUM-AX->LISPVALUE 
  (vla-get-Origin (vlax-ename->vla-object InsertEName)) 
       ) ;_ GXL-NUM-AX->LISPVALUE 
       '(1 1 1) 
) ;_ list 
      ) ;_ progn 
      (progn 
(setq ZAxis   (GXL-NUM-AX->LISPVALUE (vla-get-Normal InsertEname)) 
       InsertAngle (vla-get-Rotation InsertEname) 
       NCSXAxis   (trans (list (cos InsertAngle) (sin InsertAngle) 0.0) 
     ZAxis 
     0 
     ) ;_ end trans 
) ;_ end setq 
(list 
   NCSXAxis 
   (VectorCrossProduct ZAxis NCSXAxis) 
   ZAxis 
   (trans 
     (GXL-NUM-AX->LISPVALUE (vla-get-InsertionPoint InsertEname)) 
     ZAxis 
     0 
   ) ;_ trans 
   (list (vla-get-XScaleFactor InsertEname) 
  (vla-get-YScaleFactor InsertEname) 
  (vla-get-ZScaleFactor InsertEname) 
   ) ;_ end list 
) ;_ end list 
      ) ;_ progn 
    ) ;_ if 
  ) ;_ end defun 
  (defun VectorCrossProduct (InputVector1 InputVector2) 
    (list (- (* (cadr InputVector1) (caddr InputVector2)) 
      (* (cadr InputVector2) (caddr InputVector1)) 
   ) ;_ end - 
   (- (* (caddr InputVector1) (car InputVector2)) 
      (* (caddr InputVector2) (car InputVector1)) 
   ) ;_ end - 
   (- (* (car InputVector1) (cadr InputVector2)) 
      (* (car InputVector2) (cadr InputVector1)) 
   ) ;_ end - 
    ) ;_ end list 
  ) ;_ end defun 
  (defun 3DTransformAB (XA YA ZA OA SA P1 /) 
    (setq P1 (mapcar '* P1 SA)) 
    (mapcar '+ 
     OA 
     (list (+ (* (car XA) (car P1)) 
       (* (car YA) (cadr P1)) 
       (* (car ZA) (caddr P1)) 
    ) ;_ end + 
    (+ (* (cadr XA) (car P1)) 
       (* (cadr YA) (cadr P1)) 
       (* (cadr ZA) (caddr P1)) 
    ) ;_ end + 
    (+ (* (caddr XA) (car P1)) 
       (* (caddr YA) (cadr P1)) 
       (* (caddr ZA) (caddr P1)) 
    ) ;_ end + 
     ) ;_ end list 
    ) ;_ end mapcar 
  ) ;_ end defun 
  (defun 3DTransformBA (XA YA ZA OA SA P1 /) 
    (setq P1 (mapcar '- P1 OA)) 
    (mapcar '/ 
     (list (+ (* (car XA) (car P1)) 
       (* (cadr XA) (cadr P1)) 
       (* (caddr XA) (caddr P1)) 
    ) ;_ end + 
    (+ (* (car YA) (car P1)) 
       (* (cadr YA) (cadr P1)) 
       (* (caddr YA) (caddr P1)) 
    ) ;_ end + 
    (+ (* (car ZA) (car P1)) 
       (* (cadr ZA) (cadr P1)) 
       (* (caddr ZA) (caddr P1)) 
    ) ;_ end + 
     ) ;_ end list 
     SA 
    ) ;_ end mapcar 
  ) ;_ end defun 
;主程序 
  (setq blks (vla-get-blocks *ACDOCUMENT*)) 
  (if (= 'str (type InsertEName)) 
    (progn 
      (setq XformSpec (BlockToInsertSetup InsertEName) 
     BlockName InsertEName 
      ) ;_ setq 
      (setq InsertEName (vla-Item blks InsertEName)) 
      (setq 
oldInsPt1 (GXL-NUM-AX->LISPVALUE (vla-get-Origin InsertEName)) 
      ) ;_ setq 
    ) ;_ progn 
    (progn 
      (if (= 'ename (type InsertEName)) 
(setq InsertEName (vlax-ename->vla-object InsertEName)) 
) 
      (setq oldInsPt1 (GXL-NUM-AX->LISPVALUE 
   (vla-get-InsertionPoint InsertEName) 
        ) 
     BlockName (vla-get-name InsertEName) 
     XformSpec (BlockToInsertSetup InsertEName) 
      ) ;_ setq 
    ) ;_ progn 
  ) ;_ if 
  (setq oldInsPt2 (InsertToBlockXform oldInsPt1 XformSpec) 
newInsPt2 (InsertToBlockXform newInsPt1 XformSpec) 
  ) ;_ setq 
  (setq blkdef (vla-item blks BlockName)) 
  (vlax-for obj blkdef 
    (vla-move obj 
       (vlax-3d-point newInsPt2) 
       (vlax-3d-point oldInsPt2) 
    ) ;_ vla-move 
  ) ;_ vlax-for 
;;;修改块定义基点 
  (vlax-for blk blks 
    (vlax-for obj blk 
      (cond ((and (= "AcDbBlockReference" (vla-get-ObjectName obj)) 
    (= (strcase BlockName) (strcase (vla-get-name obj))) 
      ) ;_ and 
      (setq XformSpec (BlockToInsertSetup obj)) 
      (setq oldInsPt1 (BlockToInsertXform oldInsPt2 XformSpec) 
     newInsPt1 (BlockToInsertXform newInsPt2 XformSpec) 
      ) ;_ setq 
      (vla-move obj 
         (vlax-3d-point oldInsPt1) 
         (vlax-3d-point newInsPt1) 
      ) ;_ vla-move 
      (if (setq atts (GXL-NUM-AX->LISPVALUE (vla-GetAttributes obj))) 
        (foreach att atts 
   (vla-move att 
         (vlax-3d-point newInsPt1) 
         (vlax-3d-point oldInsPt1) 
      ) 
   ) 
        ) 
     ) 
     ((and (= "AcDbMInsertBlock" (vla-get-ObjectName obj)) 
    (= (strcase BlockName) (strcase (vla-get-name obj))) 
      ) ;_ and 
      (setq XformSpec (BlockToInsertSetup obj)) 
      (setq oldInsPt1 (BlockToInsertXform oldInsPt2 XformSpec) 
     newInsPt1 (BlockToInsertXform newInsPt2 XformSpec) 
      ) ;_ setq 
      (vla-move obj 
         (vlax-3d-point oldInsPt1) 
         (vlax-3d-point newInsPt1) 
      ) ;_ vla-move 
      (if (setq atts (GXL-NUM-AX->LISPVALUE (vla-GetAttributes obj))) 
        (foreach att atts 
   (vla-move att 
         (vlax-3d-point newInsPt1) 
         (vlax-3d-point oldInsPt1) 
      ) 
   ) 
        ) 
     ) 
      ) ;_ cond 
    ) ;_ vlax-for 
  ) ;_ vlax-for 
  (vla-regen *ACDOCUMENT* acActiveViewport) 
) 
(defun gxl-Num-AX->LispValue (v) 
  (cond ((= (type v) 'variant) (gxl-Num-AX->LispValue (vlax-variant-value v))) 
((= (type v) 'safearray) 
  (mapcar 'gxl-Num-AX->LispValue (safearray-value  v)) 
) 
((= (type v) 'list) 
  (mapcar 'gxl-Num-AX->LispValue v) 
  ) 
(T v) 
  ) 
  )

duotu007 · 发表于 2011-4-20 16:22:50

很久以前下的，分享下。

e2002 · 发表于 2024-9-3 12:03:40

本帖最后由 e2002 于 2024-9-3 12:57 编辑

这个需求确实困扰用户很多年，当年楼主发出此贴后，Gu版很快就给出了源码，算是解决了这个问题。Gu版的代码很强大，但无奈本人水平有限，基本上是看不懂，特别是涉及到矩阵变换的相关函数，完全就是懵的...

这十几年偶尔有空就翻出Gu版的代码学习，逐渐理解了处理的算法，只是在矩阵变换上还是有些看不明白。

前几天偶然翻到高飞写的 “ trans 函数详细解析” 的帖子，好像一下就理解了这个向量的变换。对于修改块基点同时不改变已有Insert对象的位置，理清了思路...

然后就是做好测试图块，写测试向量变换的代码，过程中也掉进去好几个坑，最后终于测试正确了。
最后就是按自己的思路把全部代码写出来（其实关键的向量变换代码已经在之前的测试代码中写好了）。
稍微测试一下，修改了几处变量名称书写错误，搞定！

全部代码，加上调用的两个通用函数 lkvl:ss2list , lkvl:layer:lockP ，也就一百多行（暂不处理MINSERT，这玩意个人很不喜欢，以后再说了）。

仲文玉 · 发表于 2011-4-20 15:45:24

也就是重新定义块的基点

xiaxiang · 发表于 2011-4-20 16:05:31

贱人工具箱。。。

仲文玉 · 发表于 2011-4-20 16:41:21

回复 duotu007 的帖子

谢谢老兄！

xiaxiang · 发表于 2011-4-20 17:35:02

本帖最后由 xiaxiang 于 2011-4-20 17:35 编辑

两个功能
1.改块名
2.改基点
搞定移动，复制，缩放，旋转，镜像等等。

啵浪鼓 · 发表于 2011-4-21 03:16:03

本来块的基点在中心，后经过无数调用，复制，旋转，镜像后，基点跑位了，如何能知道此块本来的基点呢并还原呢

scnc001 · 发表于 2011-5-8 19:59:54

好不容易找到了，下载不了啊？

masterlong · 发表于 2011-5-9 23:50:54

啵浪鼓发表于 2011-4-21 03:16
本来块的基点在中心，后经过无数调用，复制，旋转，镜像后，基点跑位了，如何能知道此块本来的基点呢并还原 ...

问过的问题
好歹关注一下有没人回答吧

啵浪鼓 · 发表于 2011-5-10 01:02:11

回复 masterlong 的帖子

此程序对于我的程序无效啊。我想让程序将所有的块基点回复在最初状态

早之前有开过贴了，暂时解决不了！
http://bbs.mjtd.com/thread-86467-1-1.html

账号		自动登录	找回密码
密码			注册

修改图块基点（已解决）

本帖被以下淘专辑推荐:

评分

本帖子中包含更多资源

评分

本帖子中包含更多资源

评分