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

pxt2001

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

寒潮大冬瓜

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

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

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

rongjiawen

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

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

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

头大无恼

错误: 函数错误: nil

求助，我也是这样改不了

zark

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

Gu_xl

回复 pxt2001 的帖子

1. ;;;(gxl-blk-att2init ent) 图块属性还原归位
   
2. ;测试 (gxl-blk-att2init (car(entsel "\n选择图块")))
   
3. (defun gxl-blk-att2init (ent /     obj   inspt
   
4.         Ownerobj    atts   objs
   
5.         attinspt    rot   xscale
   
6.         yscale    zscale  Alignment
   
7.         Backward    ObliqueAngle  Rotation
   
8.         TextAlignmentPoint
   
9.         TextGenerationFlag   UpsideDown
   
10.         TrueColor
    
11.        )
    
12.   (if (= 'ename (type ent))
    
13.     (setq obj (vlax-ename->vla-object ent))
    
14.     (setq obj ent)
    
15.     )
    
16.   (setq Ownerobj (vla-Item (vla-get-blocks (vla-get-ActiveDocument(vlax-get-acad-object))) (vla-get-name obj)))
    
17.   (vlax-for a Ownerobj
    
18.     (setq objs (cons a objs))
    
19.     )
    
20.   (setq objs (reverse objs))
    
21.   (setq rot (vla-get-Rotation obj)
    
22. xscale (vla-get-XScaleFactor obj)
    
23. yscale (vla-get-yScaleFactor obj)
    
24. zscale (vla-get-zScaleFactor obj)
    
25. )
    
26.   (vla-put-Rotation obj 0)
    
27.   (vla-put-XScaleFactor obj 1)
    
28.   (vla-put-yScaleFactor obj 1)
    
29.   (vla-put-zScaleFactor obj 1)
    
30.   (setq atts (vla-GetAttributes obj)
    
31. atts (safearray-value(vlax-variant-value atts))
    
32. inspt (vlax-safearray->list(vlax-variant-value (vla-get-InsertionPoint obj)))
    
33. )
    
34.   (if atts
    
35.     (progn
    
36.       (foreach att atts
    
37. (vl-some '(lambda (x) (= (GXL-CATCHAPPLY vla-get-TagString (list (setq Ownerobj x))) (vla-get-TagString att)))  objs)
    
38. (setq attinspt (vlax-safearray->list (vlax-variant-value(vla-get-InsertionPoint Ownerobj))))
    
39. (setq Alignment (vla-get-Alignment Ownerobj)
    
40.        Backward (vla-get-Backward Ownerobj)
    
41.        ObliqueAngle (vla-get-ObliqueAngle Ownerobj)
    
42.        Rotation (vla-get-Rotation Ownerobj)
    
43.        TextAlignmentPoint (vla-get-TextAlignmentPoint Ownerobj)
    
44.        TextGenerationFlag (vla-get-TextGenerationFlag Ownerobj)
    
45.        UpsideDown(vla-get-UpsideDown Ownerobj)
    
46.        TrueColor (vla-get-TrueColor Ownerobj)
    
47.        )
    
48. 
    
49.       (vla-put-Alignment att Alignment)
    
50.       (vla-put-Backward att Backward)
    
51.       (vla-put-ObliqueAngle att ObliqueAngle)
    
52.       (vla-put-Rotation att Rotation)
    
53.       (VL-CATCH-ALL-APPLY 'vla-put-TextGenerationFlag (list att TextGenerationFlag))
    
54.       (vla-put-Alignment att Alignment)
    
55.       (vla-put-UpsideDown att UpsideDown)
    
56.       (vla-put-TrueColor att TrueColor)
    
57.       (VL-CATCH-ALL-APPLY ‘vla-put-TextAlignmentPoint (list att (vlax-3d-point (mapcar '+ inspt (vlax-safearray->list (vlax-variant-value TextAlignmentPoint))))))
    
58.       )
    
59.       (vla-put-Rotation obj rot)
    
60.       (vla-put-XScaleFactor obj XScale)
    
61.       (vla-put-yScaleFactor obj yScale)
    
62.       (vla-put-zScaleFactor obj zScale)
    
63.       )
    
64.     )
    
65.   )
    
66. (defun gxl-CatchApply (fun args / rtn )
    
67.   (if
    
68.     (not
    
69.       (vl-catch-all-error-p
    
70.         (setq rtn
    
71.           (vl-catch-all-apply (function fun) args)
    
72.         )
    
73.       )
    
74.     )
    
75.     rtn
    
76.   )
    
77. )
    
78. ;;;属性复位 编制 Gu_xl 2011.05.15
    
79. (defun c:initatt ()
    
80.   (while (setq ss (ssget '((0 . "insert"))))
    
81.     (setq n (sslength ss))
    
82.     (repeat n
    
83.       (gxl-blk-att2init (ssname ss (setq n (1- n))))
    
84.       )
    
85.     )
    
86.   (princ)
    
87.   )
    

;;;(gxl-blk-att2init ent) 图块属性还原归位<br /> ;测试 (gxl-blk-att2init (car(entsel "\n选择图块")))<br /> (defun gxl-blk-att2init (ent /     obj   inspt<br />         Ownerobj    atts   objs<br />         attinspt    rot   xscale<br />         yscale    zscale  Alignment<br />         Backward    ObliqueAngle  Rotation<br />         TextAlignmentPoint<br />         TextGenerationFlag   UpsideDown<br />         TrueColor<br />        ) <br />   (if (= 'ename (type ent))<br />     (setq obj (vlax-ename->vla-object ent))<br />     (setq obj ent)<br />     )<br />   (setq Ownerobj (vla-Item (vla-get-blocks (vla-get-ActiveDocument(vlax-get-acad-object))) (vla-get-name obj)))<br />   (vlax-for a Ownerobj<br />     (setq objs (cons a objs))<br />     )<br />   (setq objs (reverse objs))<br />   (setq rot (vla-get-Rotation obj)<br /> xscale (vla-get-XScaleFactor obj)<br /> yscale (vla-get-yScaleFactor obj)<br /> zscale (vla-get-zScaleFactor obj)<br /> )<br />   (vla-put-Rotation obj 0)<br />   (vla-put-XScaleFactor obj 1)<br />   (vla-put-yScaleFactor obj 1)<br />   (vla-put-zScaleFactor obj 1)<br />   (setq atts (vla-GetAttributes obj)<br /> atts (safearray-value(vlax-variant-value atts))<br /> inspt (vlax-safearray->list(vlax-variant-value (vla-get-InsertionPoint obj)))<br /> )<br />   (if atts<br />     (progn<br />       (foreach att atts<br /> (vl-some '(lambda (x) (= (GXL-CATCHAPPLY vla-get-TagString (list (setq Ownerobj x))) (vla-get-TagString att)))  objs)<br /> (setq attinspt (vlax-safearray->list (vlax-variant-value(vla-get-InsertionPoint Ownerobj))))<br /> (setq Alignment (vla-get-Alignment Ownerobj)<br />        Backward (vla-get-Backward Ownerobj)<br />        ObliqueAngle (vla-get-ObliqueAngle Ownerobj)<br />        Rotation (vla-get-Rotation Ownerobj)<br />        TextAlignmentPoint (vla-get-TextAlignmentPoint Ownerobj)<br />        TextGenerationFlag (vla-get-TextGenerationFlag Ownerobj)<br />        UpsideDown(vla-get-UpsideDown Ownerobj)<br />        TrueColor (vla-get-TrueColor Ownerobj)<br />        )<br /> <br />       (vla-put-Alignment att Alignment)<br />       (vla-put-Backward att Backward)<br />       (vla-put-ObliqueAngle att ObliqueAngle)<br />       (vla-put-Rotation att Rotation)<br />       (VL-CATCH-ALL-APPLY 'vla-put-TextGenerationFlag (list att TextGenerationFlag))<br />       (vla-put-Alignment att Alignment)<br />       (vla-put-UpsideDown att UpsideDown)<br />       (vla-put-TrueColor att TrueColor)<br />       (VL-CATCH-ALL-APPLY ‘vla-put-TextAlignmentPoint (list att (vlax-3d-point (mapcar '+ inspt (vlax-safearray->list (vlax-variant-value TextAlignmentPoint))))))<br />       )<br />       (vla-put-Rotation obj rot)<br />       (vla-put-XScaleFactor obj XScale)<br />       (vla-put-yScaleFactor obj yScale)<br />       (vla-put-zScaleFactor obj zScale)<br />       )<br />     )<br />   )<br /> (defun gxl-CatchApply (fun args / rtn )<br />   (if<br />     (not<br />       (vl-catch-all-error-p<br />         (setq rtn<br />           (vl-catch-all-apply (function fun) args)<br />         )<br />       )<br />     )<br />     rtn<br />   )<br /> )<br /> ;;;属性复位 编制 Gu_xl 2011.05.15<br /> (defun c:initatt ()<br />   (while (setq ss (ssget '((0 . "insert"))))<br />     (setq n (sslength ss))<br />     (repeat n<br />       (gxl-blk-att2init (ssname ss (setq n (1- n))))<br />       )<br />     )<br />   (princ)<br />   )<br />

chshsl

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

mj0000

回复 Gu_xl 的帖子

缺少函数 GXL-CATCHAPPLY

祥子

CAD本身命令 battman

mj0000

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

shxm112233

看看不能用啊！！

skynoon

留个脚印，等GXL-CATCHAPPLY

jfxia

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

      等函数