daidong013 发表于 2011-6-22 21:49 static/image/common/back.gif
回复 xiaxiang 的帖子
请改一下vlx的快捷键，快捷键有冲突，把TT改成EDIT_BLOCK就可以了！~~
这个问题有关概念。打好基础才是王道！我们都应该加强学习。
本帖最后由 highflybird 于 2011-6-23 23:51 编辑
Xiangxiang的程序有个bug.没考虑嵌套块。
跟Lee Mac 的一样，
现在我把Lee Mac修改后的程序传上来，这个bug已经修正。
2008可以直接修改块基点吧,双击打开块编辑,
本帖最后由 highflybird 于 2011-6-24 13:12 编辑
kwok 发表于 2011-6-24 12:55 http://bbs.mjtd.com/static/image/common/back.gif
2008可以直接修改块基点吧,双击打开块编辑,
可以吗？请示例。
基点和插入点是不同的。
再说人家要的是lisp，而不是命令式的。
感谢各位热心支持
非常恼人的问题啊
本帖最后由 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)
)
)
命令: cbb ; 错误: no function definition: GXL-SEL-ENTSEL
命令:
命令: 'VLIDE
命令:
命令: BlockBase
; 错误: no function definition: GXL-SEL-ENTSEL
缺少GXL版主的 GXL-SEL-ENTSEL函数
回复 仲文玉 的帖子
楼上已修改！
回复 Gu_xl 的帖子
error: too few arguments