明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 32928|回复: 78

修改图块基点(已解决)

  [复制链接]
发表于 2011-4-20 15:43 | 显示全部楼层 |阅读模式
本帖最后由 仲文玉 于 2011-7-6 15:34 编辑

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

     感谢各位的热心帮助



该贴已经同步到 仲文玉的微博
"觉得好,就打赏"
还没有人打赏,支持一下

本帖被以下淘专辑推荐:

发表于 2011-7-5 20:04 | 显示全部楼层
本帖最后由 Gu_xl 于 2011-7-6 15:49 编辑

与Lee Mac不同,图块基点修改 ,但图块实际位置保持不变
  1. ;;;图块基点修改 ,但图块实际位置保持不变
  2. ;;;明经通道 编制 By Gu_xl 2011年7月
  3. (defun c:CBB () (c:BlockBase))
  4. (defun c:BlockBase (/ loop base)
  5.   (while (and
  6.              (setq en (car (entsel "\n 选择一个图块:" )))
  7.              (= "INSERT" (cdr (assoc 0 (entget en))))
  8.            )
  9.     (setq base (cdr (assoc 10 (entget en))))
  10.     (sssetfirst nil (ssadd en))
  11.     (setq pt (getpoint base "\n 图块新基点"))
  12.     (if pt (gxl-BlockBaseEdit en pt))
  13.     ;(sssetfirst)
  14.     )
  15.   )
  16. (defun gxl-BlockBaseEdit (InsertEName      newInsPt1
  17.         /         BlockToInsertXform
  18.         InsertToBlockXform
  19.         BlockToInsertSetup
  20.         VectorCrossProduct
  21.         3DTransformAB    3DTransformBA
  22.         blks        LOOP
  23.         sel        BlockName
  24.         blkdef        oldInsPt1
  25.         oldInsPt2        newInsPt2
  26.         ss        idx
  27.         XformSpec atts att *ACDOCUMENT*
  28.        )
  29.   (setq *ACDOCUMENT* (vla-get-ActiveDocument (vlax-get-acad-object)))
  30. ;;;子程序
  31.   (defun BlockToInsertXform (P1 TransformSpec)
  32.     (3dTransformAB
  33.       (nth 0 TransformSpec)
  34.       (nth 1 TransformSpec)
  35.       (nth 2 TransformSpec)
  36.       (nth 3 TransformSpec)
  37.       (nth 4 TransformSpec)
  38.       P1
  39.     ) ;_ end 3dTransformAB
  40.   ) ;_ end defun
  41.   (defun InsertToBlockXform (P1 TransformSpec)
  42.     (3dTransformBA
  43.       (nth 0 TransformSpec)
  44.       (nth 1 TransformSpec)
  45.       (nth 2 TransformSpec)
  46.       (nth 3 TransformSpec)
  47.       (nth 4 TransformSpec)
  48.       P1
  49.     ) ;_ end 3dTransformBA
  50.   ) ;_ end defun
  51.   (defun BlockToInsertSetup (InsertEname   /   InsertEList
  52.         ZAxis    NCSXAxis  InsertAngle
  53.        )
  54.     (if (= 'str (type InsertEName))
  55.       (progn
  56. (setq InsertEName
  57.         (vlax-vla-object->ename
  58.    (vla-Item blks InsertEName)
  59.         ) ;_ vlax-vla-object->ename
  60. ) ;_ setq
  61. (list '(1 0 0)
  62.        '(0 1 0)
  63.        '(0 0 1)
  64.        (GXL-NUM-AX->LISPVALUE
  65.   (vla-get-Origin (vlax-ename->vla-object InsertEName))
  66.        ) ;_ GXL-NUM-AX->LISPVALUE
  67.        '(1 1 1)
  68. ) ;_ list
  69.       ) ;_ progn
  70.       (progn
  71. (setq ZAxis   (GXL-NUM-AX->LISPVALUE (vla-get-Normal InsertEname))
  72.        InsertAngle (vla-get-Rotation InsertEname)
  73.        NCSXAxis   (trans (list (cos InsertAngle) (sin InsertAngle) 0.0)
  74.      ZAxis
  75.      0
  76.      ) ;_ end trans
  77. ) ;_ end setq
  78. (list
  79.    NCSXAxis
  80.    (VectorCrossProduct ZAxis NCSXAxis)
  81.    ZAxis
  82.    (trans
  83.      (GXL-NUM-AX->LISPVALUE (vla-get-InsertionPoint InsertEname))
  84.      ZAxis
  85.      0
  86.    ) ;_ trans
  87.    (list (vla-get-XScaleFactor InsertEname)
  88.   (vla-get-YScaleFactor InsertEname)
  89.   (vla-get-ZScaleFactor InsertEname)
  90.    ) ;_ end list
  91. ) ;_ end list
  92.       ) ;_ progn
  93.     ) ;_ if
  94.   ) ;_ end defun
  95.   (defun VectorCrossProduct (InputVector1 InputVector2)
  96.     (list (- (* (cadr InputVector1) (caddr InputVector2))
  97.       (* (cadr InputVector2) (caddr InputVector1))
  98.    ) ;_ end -
  99.    (- (* (caddr InputVector1) (car InputVector2))
  100.       (* (caddr InputVector2) (car InputVector1))
  101.    ) ;_ end -
  102.    (- (* (car InputVector1) (cadr InputVector2))
  103.       (* (car InputVector2) (cadr InputVector1))
  104.    ) ;_ end -
  105.     ) ;_ end list
  106.   ) ;_ end defun
  107.   (defun 3DTransformAB (XA YA ZA OA SA P1 /)
  108.     (setq P1 (mapcar '* P1 SA))
  109.     (mapcar '+
  110.      OA
  111.      (list (+ (* (car XA) (car P1))
  112.        (* (car YA) (cadr P1))
  113.        (* (car ZA) (caddr P1))
  114.     ) ;_ end +
  115.     (+ (* (cadr XA) (car P1))
  116.        (* (cadr YA) (cadr P1))
  117.        (* (cadr ZA) (caddr P1))
  118.     ) ;_ end +
  119.     (+ (* (caddr XA) (car P1))
  120.        (* (caddr YA) (cadr P1))
  121.        (* (caddr ZA) (caddr P1))
  122.     ) ;_ end +
  123.      ) ;_ end list
  124.     ) ;_ end mapcar
  125.   ) ;_ end defun
  126.   (defun 3DTransformBA (XA YA ZA OA SA P1 /)
  127.     (setq P1 (mapcar '- P1 OA))
  128.     (mapcar '/
  129.      (list (+ (* (car XA) (car P1))
  130.        (* (cadr XA) (cadr P1))
  131.        (* (caddr XA) (caddr P1))
  132.     ) ;_ end +
  133.     (+ (* (car YA) (car P1))
  134.        (* (cadr YA) (cadr P1))
  135.        (* (caddr YA) (caddr P1))
  136.     ) ;_ end +
  137.     (+ (* (car ZA) (car P1))
  138.        (* (cadr ZA) (cadr P1))
  139.        (* (caddr ZA) (caddr P1))
  140.     ) ;_ end +
  141.      ) ;_ end list
  142.      SA
  143.     ) ;_ end mapcar
  144.   ) ;_ end defun
  145. ;主程序
  146.   (setq blks (vla-get-blocks *ACDOCUMENT*))
  147.   (if (= 'str (type InsertEName))
  148.     (progn
  149.       (setq XformSpec (BlockToInsertSetup InsertEName)
  150.      BlockName InsertEName
  151.       ) ;_ setq
  152.       (setq InsertEName (vla-Item blks InsertEName))
  153.       (setq
  154. oldInsPt1 (GXL-NUM-AX->LISPVALUE (vla-get-Origin InsertEName))
  155.       ) ;_ setq
  156.     ) ;_ progn
  157.     (progn
  158.       (if (= 'ename (type InsertEName))
  159. (setq InsertEName (vlax-ename->vla-object InsertEName))
  160. )
  161.       (setq oldInsPt1 (GXL-NUM-AX->LISPVALUE
  162.    (vla-get-InsertionPoint InsertEName)
  163.         )
  164.      BlockName (vla-get-name InsertEName)
  165.      XformSpec (BlockToInsertSetup InsertEName)
  166.       ) ;_ setq
  167.     ) ;_ progn
  168.   ) ;_ if
  169.   (setq oldInsPt2 (InsertToBlockXform oldInsPt1 XformSpec)
  170. newInsPt2 (InsertToBlockXform newInsPt1 XformSpec)
  171.   ) ;_ setq
  172.   (setq blkdef (vla-item blks BlockName))
  173.   (vlax-for obj blkdef
  174.     (vla-move obj
  175.        (vlax-3d-point newInsPt2)
  176.        (vlax-3d-point oldInsPt2)
  177.     ) ;_ vla-move
  178.   ) ;_ vlax-for
  179. ;;;修改块定义基点
  180.   (vlax-for blk blks
  181.     (vlax-for obj blk
  182.       (cond ((and (= "AcDbBlockReference" (vla-get-ObjectName obj))
  183.     (= (strcase BlockName) (strcase (vla-get-name obj)))
  184.       ) ;_ and
  185.       (setq XformSpec (BlockToInsertSetup obj))
  186.       (setq oldInsPt1 (BlockToInsertXform oldInsPt2 XformSpec)
  187.      newInsPt1 (BlockToInsertXform newInsPt2 XformSpec)
  188.       ) ;_ setq
  189.       (vla-move obj
  190.          (vlax-3d-point oldInsPt1)
  191.          (vlax-3d-point newInsPt1)
  192.       ) ;_ vla-move
  193.       (if (setq atts (GXL-NUM-AX->LISPVALUE (vla-GetAttributes obj)))
  194.         (foreach att atts
  195.    (vla-move att
  196.          (vlax-3d-point newInsPt1)
  197.          (vlax-3d-point oldInsPt1)
  198.       )
  199.    )
  200.         )
  201.      )
  202.      ((and (= "AcDbMInsertBlock" (vla-get-ObjectName obj))
  203.     (= (strcase BlockName) (strcase (vla-get-name obj)))
  204.       ) ;_ and
  205.       (setq XformSpec (BlockToInsertSetup obj))
  206.       (setq oldInsPt1 (BlockToInsertXform oldInsPt2 XformSpec)
  207.      newInsPt1 (BlockToInsertXform newInsPt2 XformSpec)
  208.       ) ;_ setq
  209.       (vla-move obj
  210.          (vlax-3d-point oldInsPt1)
  211.          (vlax-3d-point newInsPt1)
  212.       ) ;_ vla-move
  213.       (if (setq atts (GXL-NUM-AX->LISPVALUE (vla-GetAttributes obj)))
  214.         (foreach att atts
  215.    (vla-move att
  216.          (vlax-3d-point newInsPt1)
  217.          (vlax-3d-point oldInsPt1)
  218.       )
  219.    )
  220.         )
  221.      )
  222.       ) ;_ cond
  223.     ) ;_ vlax-for
  224.   ) ;_ vlax-for
  225.   (vla-regen *ACDOCUMENT* acActiveViewport)
  226. )
  227. (defun gxl-Num-AX->LispValue (v)
  228.   (cond ((= (type v) 'variant) (gxl-Num-AX->LispValue (vlax-variant-value v)))
  229. ((= (type v) 'safearray)
  230.   (mapcar 'gxl-Num-AX->LispValue (safearray-value  v))
  231. )
  232. ((= (type v) 'list)
  233.   (mapcar 'gxl-Num-AX->LispValue v)
  234.   )
  235. (T v)
  236.   )
  237.   )




评分

参与人数 3明经币 +2 金钱 +60 收起 理由
lxl217114 + 1 + 5 很给力!
xiaobao02 + 1 + 50 很给力!
仲文玉 + 5 多谢版主

查看全部评分

回复 支持 1 反对 0

使用道具 举报

发表于 2011-4-20 16:22 | 显示全部楼层

很久以前下的,分享下。

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 1金钱 +5 收起 理由
仲文玉 + 5 感谢支持,他们画图不规范。 总算整好了,.

查看全部评分

回复 支持 1 反对 0

使用道具 举报

发表于 2020-3-3 21:48 | 显示全部楼层
图纸内容少时修改基点会快点,但内容一多运行起来就很慢,另外图块位置是没变,但如果是剪裁过的图块剪裁边界会连同基点一起改变,看来代码还有待改进。

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
 楼主| 发表于 2011-4-20 15:45 | 显示全部楼层
也就是重新定义块的基点
发表于 2011-4-20 16:05 | 显示全部楼层
贱人工具箱。。。
 楼主| 发表于 2011-4-20 16:41 | 显示全部楼层
回复 duotu007 的帖子

谢谢老兄!
发表于 2011-4-20 17:35 | 显示全部楼层
本帖最后由 xiaxiang 于 2011-4-20 17:35 编辑

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



本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 1金钱 +5 收起 理由
仲文玉 + 5 谢谢支持

查看全部评分

发表于 2011-4-21 03:16 | 显示全部楼层
本来块的基点在中心,后经过无数调用,复制,旋转,镜像后,基点跑位了,如何能知道此块本来的基点呢并还原呢
发表于 2011-5-8 19:59 | 显示全部楼层
好不容易找到了,下载不了啊?
发表于 2011-5-9 23:50 | 显示全部楼层
啵浪鼓 发表于 2011-4-21 03:16
本来块的基点在中心,后经过无数调用,复制,旋转,镜像后,基点跑位了,如何能知道此块本来的基点呢并还原 ...

问过的问题
好歹关注一下有没人回答吧
发表于 2011-5-10 01:02 | 显示全部楼层
回复 masterlong 的帖子

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

早之前有开过贴了,暂时解决不了!
http://bbs.mjtd.com/thread-86467-1-1.html
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 23:19 , Processed in 0.210760 second(s), 32 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表