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

修改图块基点（已解决）

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

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

   感谢各位的热心帮助



http://bbs.mjtd.com/xwb/images/bgimg/icon_logo.png 该贴已经同步到 仲文玉的微博

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    NCSXAxisInsertAngle
       )
    (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-valuev))
)
((= (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 static/image/common/back.gif
本来块的基点在中心，后经过无数调用，复制，旋转，镜像后，基点跑位了，如何能知道此块本来的基点呢并还原 ...

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

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

回复 masterlong 的帖子

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

早之前有开过贴了，暂时解决不了！
http://bbs.mjtd.com/thread-86467-1-1.html
页: [1] 2 3 4 5 6 7 8 9
查看完整版本: 修改图块基点（已解决）