那位，看看能否跟进一下LSP

357785513

曾在网上看过梦断江南写的改块插入点程序，发现改属性块时出问题，一旦用梦断江南的改一下属性文字会跑位那位看能否跟进一下，对了，

贴一下梦断江南的代码先

 

 

;| c:chbkins = 保持参照块位置,改块插入点(only for 平面块)-----------ok!!完成--------梦断江南.lxx.2004.10
支持:wcs,ucs, 不等比参照块.镜像块.
命令: chbkins
|;
(defun c:chbkins ( / *doc e p000 p1e p1 p2 p2x bkobj ss lst)
  (while (not(and (princ "\n请选择一个块参照:")
           (setq s (ssget ":S:E" '((0 . "INSERT"))))
  )))
  (setq *doc (vla-get-activedocument(vlax-get-acad-object))
 p000 (list 0. 0. 0.)
        e    (ssname s 0)
 bkn  (xdxf e 2)                                   ;;块名.
 p1e  (xdxf e 10)                                  ;;块插入点wcs,dcs.
 p1   (trans p1e e 1)                              ;;块插入点ucs.
        p2   (getpoint p1 "\n选择新的块插入点:"))         ;;新插入点ucs.
  (if p2
    (progn
      (setq p2x (x-inspttrans e (trans p2 1 0)) ;;块定义相对位移点.wcs.
     bkobj (vla-item (vla-get-blocks *doc) bkn)    ;;取得块定义实体.
            ss   (ssget "x" (list '(0 . "INSERT") (cons 2 (xdxf e 2))))
      )
      ;;重新定义块---改插入点.
      (vlax-for i bkobj (setq lst (cons i lst)))
      (mapcar '(lambda (x) (vla-move x (ptx p2x) (ptx p000))) lst);;ok!
      ;;移动块参照,使其位置保持原状.
      (mapcar '(lambda (x)(vla-move(x2o x)(ptx (xdxf x 10))(ptx (x-insptbak x p2x))))(xss2lst ss))
    )
  )
  (princ)
)
;;********************************************************************************
;;(x-inspttrans e pt) = 转换新插入点为原始块定义相对定位点wcs(位移向量)-----ok!
(defun x-inspttrans (e pt / obj atts attv p ang xs ys zs ) ;;for wcs
  (setq p000  (list 0. 0. 0.)
 obj   (vlax-ename->vla-object e)
 p     (xdxf e 10)
 atts '(rotation xscalefactor yscalefactor zscalefactor)
 attv  (mapcar '(lambda(x)(vlax-get obj x)) atts))
  (mapcar 'set '(ang xs ys zs) attv)
  (setq pt (polar p000 (- (angle p pt) ang) (distance p pt))
 pt (mapcar '/ pt (list xs ys zs)))
)
;;********************************************************************************
;;根据位移向量pt反求块原来的插入点wcs.------------------ok!
(defun x-insptbak (e pt / obj atts attv p ang xs ys zs) ;;for wcs
  (setq p000  (list 0. 0. 0.)
 p     (xdxf e 10)
        obj   (vlax-ename->vla-object e)
 atts '(rotation xscalefactor yscalefactor zscalefactor)
 attv  (mapcar '(lambda(x)(vlax-get obj x)) atts))
  (mapcar 'set '(ang xs ys zs) attv)
  (setq pt (mapcar '* pt (list xs ys zs))
 pt (polar p (+ (angle p000 pt) ang) (distance p000 pt)))
)
;; 点转换为 vla点.
(defun ptx (pt)
  (if (= (type pt) 'variant)
    pt
    (vlax-3d-point pt)
  )
)
;; 取得实体dxf值.
(defun xdxf (e id)
  (cdr(assoc id (entget e)))
)
;;(xss2lst ss) = 选集实体名列表.
(defun xss2lst (ss / i lst)
  (setq i -1)
  (while (setq e (ssname ss (setq i (1+ i))))
    (setq lst (cons (xdxf e -1) lst))
  )(reverse lst)
)
;;
(defun x2o (eobj)
  (if (= 'ENAME (type eobj))
    (vlax-ename->vla-object eobj)
    eobj
  )
)

357785513

能否改了属性块的插入点后属性块的文字不跑位，那位高手给看看能否改一下

zhuoxiaoxin

类似问题我曾也遇到过,也曾好像问过明总好像,后来好像它没有时间帮看看,没辙,咱也期待有人能解决这个问题