pxt2001 发表于 2011-5-14 15:36:23

有没有让属性块的属性文字“复位”的lsp

如图所求，求lsp，将属性块的“属性文字”归位。

寒潮大冬瓜 发表于 2024-5-22 10:40:21

啵浪鼓 发表于 2011-7-10 22:10
回复 Gu_xl 的帖子

命令: (gxl-blk-att2init (car(entsel "\n选择图块")))


这种情况→说明有镜像了的！如果是高程块→那么就复制一个初始属性块→粘贴进去→更新高程属性值→再删除旧属性块就搞定了

rongjiawen 发表于 2024-5-13 09:35:39

Gu_xl 发表于 2011-7-10 15:24
回复 jfxia 的帖子

GXL-CATCHAPPLY 函数三楼已补上了！

属性文字“复位”的lsp哪里可以获取？

头大无恼 发表于 2017-12-20 23:14:11

错误: 函数错误: nil

求助，我也是这样改不了

zark 发表于 2011-5-14 23:55:37

null

这个功能有点像CASS里的重生成

Gu_xl 发表于 2011-5-16 09:52:45

本帖最后由 Gu_xl 于 2011-7-10 15:21 编辑

回复 pxt2001 的帖子



;;;(gxl-blk-att2init ent) 图块属性还原归位
;测试 (gxl-blk-att2init (car(entsel "\n选择图块")))
(defun gxl-blk-att2init (ent /   obj   inspt
      Ownerobj    atts   objs
      attinspt    rot   xscale
      yscale    zscaleAlignment
      Backward    ObliqueAngleRotation
      TextAlignmentPoint
      TextGenerationFlag   UpsideDown
      TrueColor
       )
(if (= 'ename (type ent))
    (setq obj (vlax-ename->vla-object ent))
    (setq obj ent)
    )
(setq Ownerobj (vla-Item (vla-get-blocks (vla-get-ActiveDocument(vlax-get-acad-object))) (vla-get-name obj)))
(vlax-for a Ownerobj
    (setq objs (cons a objs))
    )
(setq objs (reverse objs))
(setq rot (vla-get-Rotation obj)
xscale (vla-get-XScaleFactor obj)
yscale (vla-get-yScaleFactor obj)
zscale (vla-get-zScaleFactor obj)
)
(vla-put-Rotation obj 0)
(vla-put-XScaleFactor obj 1)
(vla-put-yScaleFactor obj 1)
(vla-put-zScaleFactor obj 1)
(setq atts (vla-GetAttributes obj)
atts (safearray-value(vlax-variant-value atts))
inspt (vlax-safearray->list(vlax-variant-value (vla-get-InsertionPoint obj)))
)
(if atts
    (progn
      (foreach att atts
(vl-some '(lambda (x) (= (GXL-CATCHAPPLY vla-get-TagString (list (setq Ownerobj x))) (vla-get-TagString att)))objs)
(setq attinspt (vlax-safearray->list (vlax-variant-value(vla-get-InsertionPoint Ownerobj))))
(setq Alignment (vla-get-Alignment Ownerobj)
       Backward (vla-get-Backward Ownerobj)
       ObliqueAngle (vla-get-ObliqueAngle Ownerobj)
       Rotation (vla-get-Rotation Ownerobj)
       TextAlignmentPoint (vla-get-TextAlignmentPoint Ownerobj)
       TextGenerationFlag (vla-get-TextGenerationFlag Ownerobj)
       UpsideDown(vla-get-UpsideDown Ownerobj)
       TrueColor (vla-get-TrueColor Ownerobj)
       )

      (vla-put-Alignment att Alignment)
      (vla-put-Backward att Backward)
      (vla-put-ObliqueAngle att ObliqueAngle)
      (vla-put-Rotation att Rotation)
      (VL-CATCH-ALL-APPLY 'vla-put-TextGenerationFlag (list att TextGenerationFlag))
      (vla-put-Alignment att Alignment)
      (vla-put-UpsideDown att UpsideDown)
      (vla-put-TrueColor att TrueColor)
      (VL-CATCH-ALL-APPLY ‘vla-put-TextAlignmentPoint (list att (vlax-3d-point (mapcar '+ inspt (vlax-safearray->list (vlax-variant-value TextAlignmentPoint))))))
      )
      (vla-put-Rotation obj rot)
      (vla-put-XScaleFactor obj XScale)
      (vla-put-yScaleFactor obj yScale)
      (vla-put-zScaleFactor obj zScale)
      )
    )
)
(defun gxl-CatchApply (fun args / rtn )
(if
    (not
      (vl-catch-all-error-p
      (setq rtn
          (vl-catch-all-apply (function fun) args)
      )
      )
    )
    rtn
)
)
;;;属性复位 编制 Gu_xl 2011.05.15
(defun c:initatt ()
(while (setq ss (ssget '((0 . "insert"))))
    (setq n (sslength ss))
    (repeat n
      (gxl-blk-att2init (ssname ss (setq n (1- n))))
      )
    )
(princ)
)


chshsl 发表于 2011-5-16 21:09:21

不错,CAD自带的也有的,在修改2里,同部属性块

mj0000 发表于 2011-7-8 16:35:07

回复 Gu_xl 的帖子

缺少函数 GXL-CATCHAPPLY

祥子 发表于 2011-7-8 18:51:23

CAD本身命令 battman

mj0000 发表于 2011-7-9 10:40:53

battman修改全部的，不是很方便

shxm112233 发表于 2011-7-10 00:23:42

看看不能用啊！！

skynoon 发表于 2011-7-10 11:17:58

留个脚印，等GXL-CATCHAPPLY

jfxia 发表于 2011-7-10 15:02:55

chshsl 发表于 2011-5-16 21:09 static/image/common/back.gif
不错,CAD自带的也有的,在修改2里,同部属性块

      等函数
页: [1] 2 3
查看完整版本: 有没有让属性块的属性文字“复位”的lsp