关于移动块属性位置函数的一点建议
黄大侠的《(MJ:ChangeTagIns "sheet-text" "a3-scale" '(703.4722 17.8350 0))》函数，功能是把某一名称块的指定属性移动到指定位置。当同一图中，存在多个名称相同的块时，这种方式就失去了意义。通常，每个块的指定属性位置可能更多的是移动到相对于该块插入点的某个位置。这种情况下，函数应该如何修改才能实现呢？也就是说函数输入参数的点表变成相对于块插入点（@X Y Z）函数源码：
;;32.1 [功能] 更改属性位置
;; (MJ:ChangeTagIns "sheet-text" "a3-scale" '(703.4722 17.8350 0))
(defun MJ:ChangeTagIns (bn tagname ins / layout i atts tag)
(defun list->variantArray (ptsList / arraySpace sArray)
(setq arraySpace
(vlax-make-safearray
vlax-vbdouble
(cons 0 (- (length ptsList) 1))
)
)
(setq sArray (vlax-safearray-fill arraySpace ptsList))
(vlax-make-variant sArray)
)
(vlax-for layout *LOUTS*
(vlax-for i (vla-get-block layout)
(if (and
(= (vla-get-objectname i) "AcDbBlockReference")
(= (strcase (vla-get-name i)) (strcase bn))
)
(if (and
(= (vla-get-hasattributes i) :vlax-true)
(safearray-value
(setq atts
(vlax-variant-value
(vla-getattributes i)
)
)
)
)
(foreach tag (vlax-safearray->list atts)
(if (= (strcase tagname) (strcase (vla-get-tagstring tag)))
(vla-put-InsertionPoint tag (list->variantArray ins))
)
)
(vla-update i)
)
)
)
)
)
我试过这个普通的移动都不成功，相对位置就更不行了。不知道那个高手能出手呢？ 本帖最后由 kozmosovia 于 2024-9-29 14:33 编辑
逻辑都没搞对吧，没必要整代码，块编辑器手动改好相对位置，attsync一下就行了。
页:
[1]