如何修改块的基点?
如何修改块的基点?我想修改在图中已有的块的基点?我找了CAD的命令,没找到相关的,哪位高人,帮忙解决? 听不懂意思，是不是指把块所在的DWG文件中，打BASE命令改好基点，保存好，退出后，重新插入些块，选择更新？ 把旧的炸开，重新做个基点，然后写进去保存就可以了！ 谢谢各位.在晓东论坛有网友给了个LISP能解决! (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
)
;; Get the Entity Association List of the insert and the Z
;; axis of the NCS (and OCS)
(setq ZAxis (cdr (assoc 210 (setq InsertEList (entget InsertEName))))
;; The OCS X axis is, in OCS, '(1 0 0).The NCS X axis is
;; therefore, in OCS,
;; ((cos InsertAngle) (sin InsertAngle) 0.0).
;; Transforming this vector to WCS gives the NCS X axis in
;; WCS:
InsertAngle (cdr (assoc 50 InsertEList))
NCSXAxis (trans (list (cos InsertAngle) (sin InsertAngle) 0.0)
(cdr (assoc 210 InsertEList))
0
) ;_ end trans
) ;_ end setq
;; Set up the return value
(list NCSXAxis
;; The Y axis of the NCS (it will be a unit vector
;; because it's the cross product of two unit
;; vectors at a right angle to each other)
(VectorCrossProduct ZAxis NCSXAxis)
ZAxis
;; The insertion point of the insert
(trans (cdr (assoc 10 InsertEList)) ZAxis 0)
;; The scale factors
(list (cdr (assoc 41 InsertEList))
(cdr (assoc 42 InsertEList))
(cdr (assoc 43 InsertEList))
) ;_ end list
) ;_ end list
) ;_ 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 /)
;; Scale the input point to "B" system units
(setq P1 (mapcar '* P1 SA))
;; Translate and set up the return value
(mapcar '+
OA
;; The following does the rotation transformation
(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 /)
;; Translate
(setq P1 (mapcar '- P1 OA))
;; Scale and set up the return value
(mapcar '/
;; The following does the rotation
(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
(defun c:KK (/ doc blks LOOP sel InsertEName BlockName blkdef
oldInsPt1 newInsPt1 oldInsPt2 newInsPt2
ss idx XformSpec)
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(setq blks (vla-get-blocks doc) LOOP t)
(while LOOP
(setq sel (entsel "\n选择一个图块: "))
(if (and sel (= (cdr (assoc 0 (entget (setq InsertEName (car sel))))) "INSERT"))
(progn
(setq LOOP nil)
(setq oldInsPt1 (cdr (assoc 10 (entget InsertEName)))
BlockName (cdr (assoc 2 (entget InsertEName)))
XformSpec (BlockToInsertSetup InsertEName))
(setq newInsPt1 (getpoint oldInsPt1 "\n选择新的插入点: "))
(setq oldInsPt2 (InsertToBlockXform oldInsPt1 XformSpec)
newInsPt2 (InsertToBlockXform newInsPt1 XformSpec))
(setq blkdef (vla-item blks BlockName))
(vlax-for obj blkdef
(vla-move obj (vlax-3d-point newInsPt2) (vlax-3d-point oldInsPt2)))
(setq ss (ssget "x" (list (cons 0 "INSERT")(cons 2 BlockName))))
(setq idx 0)
(repeat (sslength ss)
(setq InsertEName (ssname ss idx)
XformSpec (BlockToInsertSetup InsertEName))
(setq oldInsPt1 (BlockToInsertXform oldInsPt2 XformSpec)
newInsPt1 (BlockToInsertXform newInsPt2 XformSpec))
(vla-move (vlax-ename->vla-object InsertEName)
(vlax-3d-point oldInsPt1) (vlax-3d-point newInsPt1))
(setq idx (1+ idx))
);repeat
);progn
);end_if
);while
(princ)
);End_defun
页:
[1]