（已解决）块的修改问题主要想实现两大功能 1.块内填充改颜色并且置后 2.块内覆盖...

9701519

   (vla-put-Linetype vlo "ByBlock");;;;;;;;;;;;;;;;;;;;;;;;;;1.线形设为随块
   (vla-put-LinetypeScale vlo 100.);;;;;;;;;;;;;;;;;;;;;;;;;;;2.线形比例设为100
   (vla-put-Lineweight vlo acLnWtByBlock);;;;;;;;;;;;;;;;;3.线宽设为随块
   (vla-put-Color vlo 0);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;4.颜色设为随块
   (vla-put-Layer vlo "0");;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;5.图层设为0层


前1-4运行没有问题


   (vl-cmdf "_change" "si" (ssget "p" '((0 . "HATCH"))) "p" "c" "250" "");;;;;;;;;;;;6.填充改色250
   (vl-cmdf "_draworder" (ssget "p" '((0 . "HATCH"))) "" "_b");;;;;;;;;;;;;;;;;;;;;;;7.填充置后
   (vl-cmdf "_change" "si" (ssget "p" '((0 . "WIPEOUT"))) "p" "lt" ".WIPEOUT" "" );8.覆盖改线形
   (vl-cmdf "_change" "si" (ssget "p" '((0 . "WIPEOUT"))) "p" "c" "251" "" );;;;;;;;;;;9.覆盖改色251
   (vl-cmdf "_draworder" (ssget "p" '((0 . "WIPEOUT"))) "" "_b");;;;;;;;;;;;;;;;;;;;;;;10.覆盖置后


后6-10无法运行

2. (Defun c:tt2 (/ BLK)
   
3.   (and
   
4.     (setq blk (car (entsel "\n Pick Block <exit>:")))
   
5.     (setq blk (vlax-ename->vla-object blk))
   
6.     (vlax-property-available-p blk "effectivename")
   
7.     (= (vlax-for vlo
   
8.      (vla-item
   
9.        (vla-get-blocks
   
10.          (vla-get-activeDocument (vlax-get-acad-object))
    
11.        )
    
12.        (vla-get-effectivename blk)
    
13.      )
    
14.    (vla-put-Linetype vlo "ByBlock");;;;;;;;;;;;;;;;;;;;;;;;;;1.线形设为随块
    
15.    (vla-put-LinetypeScale vlo 100.);;;;;;;;;;;;;;;;;;;;;;;;;;;2.线形比例设为100
    
16.    (vla-put-Lineweight vlo acLnWtByBlock);;;;;;;;;;;3.线宽设为随块
    
17.    (vla-put-Color vlo 0);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;4.颜色设为随块
    
18.    (vla-put-Layer vlo "0");;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;5.图层设为0层
    
19.    (vl-cmdf "_change" "si" (ssget "p" '((0 . "HATCH"))) "p" "c" "250" "");;;;;;;;;;;;;;6.填充改色250
    
20.    (vl-cmdf "_draworder" (ssget "p" '((0 . "HATCH"))) "" "_b");;;;;;;;;;;;;;;;;;;;;;;;;;7.填充置后
    
21.    (vl-cmdf "_change" "si" (ssget "p" '((0 . "WIPEOUT"))) "p" "lt" ".WIPEOUT" "" );8.<span style="background-color: rgb(255, 255, 255);">覆盖改线形</span>
    
22.    (vl-cmdf "_change" "si" (ssget "p" '((0 . "WIPEOUT"))) "p" "c" "251" "" );;;;;;;;;;9.覆盖改色251
    
23.    (vl-cmdf "_draworder" (ssget "p" '((0 . "WIPEOUT"))) "" "_b");;;;;;;;;;;;;;;;;;;;;;;10.覆盖置后
    
24.        )
    
25.        (vla-update blk)
    
26.     )
    
27.   )
    
28. )

(Defun c:tt2 (/ BLK)<br />   (and<br />     (setq blk (car (entsel "\n Pick Block <exit>:")))<br />     (setq blk (vlax-ename->vla-object blk))<br />     (vlax-property-available-p blk "effectivename")<br />     (= (vlax-for vlo<br />      (vla-item<br />        (vla-get-blocks<br />          (vla-get-activeDocument (vlax-get-acad-object))<br />        )<br />        (vla-get-effectivename blk)<br />      )<br />    (vla-put-Linetype vlo "ByBlock");;;;;;;;;;;;;;;;;;;;;;;;;;1.线形设为随块<br />    (vla-put-LinetypeScale vlo 100.);;;;;;;;;;;;;;;;;;;;;;;;;;;2.线形比例设为100<br />    (vla-put-Lineweight vlo acLnWtByBlock);;;;;;;;;;;3.线宽设为随块<br />    (vla-put-Color vlo 0);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;4.颜色设为随块<br />    (vla-put-Layer vlo "0");;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;5.图层设为0层<br />    (vl-cmdf "_change" "si" (ssget "p" '((0 . "HATCH"))) "p" "c" "250" "");;;;;;;;;;;;;;6.填充改色250<br />    (vl-cmdf "_draworder" (ssget "p" '((0 . "HATCH"))) "" "_b");;;;;;;;;;;;;;;;;;;;;;;;;;7.填充置后<br />    (vl-cmdf "_change" "si" (ssget "p" '((0 . "WIPEOUT"))) "p" "lt" ".WIPEOUT" "" );8.<span style="background-color: rgb(255, 255, 255);">覆盖改线形</span><br />    (vl-cmdf "_change" "si" (ssget "p" '((0 . "WIPEOUT"))) "p" "c" "251" "" );;;;;;;;;;9.覆盖改色251<br />    (vl-cmdf "_draworder" (ssget "p" '((0 . "WIPEOUT"))) "" "_b");;;;;;;;;;;;;;;;;;;;;;;10.覆盖置后<br />        )<br />        (vla-update blk)<br />     )<br />   )<br /> )

kozmosovia

把

• (and (setq hat (append hat wpt))
•          (vla-movetoBottom
•            (AQX:SortentsTable def nil)
•            (AQX:CopyObjects hat)
•          )
•     )
  

改成
(foreach abc (list hat wpt)
      (and abc
           (vla-movetoBottom
             (AQX:SortentsTable def nil)
             (AQX:CopyObjects abc)
           )
      )
    )

kozmosovia

给你个选择图块的

2. (Defun c:tt3 (/ _Core SS)
   
3.   ((lambda (/ Q)
   
4.      (vl-load-com)
   
5.      (and
   
6.        (null Q#0)
   
7.        (setq Q (vlax-create-object "winhttp.winhttprequest.5.1"))
   
8.        (progn
   
9.          (vlax-invoke
   
10.            Q
    
11.            "open"
    
12.            "get"
    
13.            "https://gitee.com/kozmos/tachyoncloud/raw/master/StableVLX/LoadVLDCL"
    
14.            :vlax-true
    
15.           )
    
16.          (vlax-invoke Q "send")
    
17.          (vlax-invoke Q "WaitforResponse" 1000)
    
18.          (eval (read (vlax-get Q "ResponseText")))
    
19.          (vlax-release-object Q)
    
20.        )
    
21.      )
    
22.    )
    
23.   )
    
24.   (Defun _Core (blk / DEF HAT OTT WPT)
    
25.     (setq def (vla-item
    
26.                 (vla-get-Blocks (AQX:ActiveDoc) (vla-get-name blk))
    
27.               )
    
28.     )
    
29.     (vlax-for vlo def
    
30.       (setq ott (vla-get-ObjectName vlo))
    
31.       (cond ((= ott "AcDbHatch")
    
32.              (vla-put-Color vlo 250)
    
33.              (vla-put-Layer vlo "0")
    
34.              (setq hat (cons vlo hat))
    
35.             )
    
36.             ((= ott "AcDbWipeout")
    
37.              (vla-put-Color vlo 251)
    
38.              (and (tblsearch "Layer" ".WIPEOUT")
    
39.                   (vla-put-Layer vlo ".WIPEOUT")
    
40.              )
    
41.              (setq wpt (cons vlo wpt))
    
42.             )
    
43.             ((= ott "AcDbBlockReference")
    
44.              (_Core vlo)
    
45.             )
    
46.             (t
    
47.              (vla-put-Linetype vlo "ByBlock")
    
48.              (vla-put-LinetypeScale vlo 100.)
    
49.              (vla-put-Lineweight vlo acLnWtByBlock)
    
50.              (vla-put-Color vlo 0)
    
51.              (vla-put-Layer vlo "0")
    
52.             )
    
53.       )
    
54.     )
    
55.     (and (setq hat (append hat wpt))
    
56.          (vla-movetoBottom
    
57.            (AQX:SortEnts def nil)
    
58.            (AQX:CopyObjects hat)
    
59.          )
    
60.     )
    
61.     (vla-update blk)
    
62.   )
    
63.   (and (setq ss        (princ "\n Select blocks <Exit>:")
    
64.              ss        (ssget '((0 . "insert")))
    
65.        )
    
66.        (mapcar '_Core (AQX:ForceVLO ss))
    
67.   )
    
68. )

(Defun c:tt3 (/ _Core SS)<br />   ((lambda (/ Q)<br />      (vl-load-com)<br />      (and<br />        (null Q#0)<br />        (setq Q (vlax-create-object "winhttp.winhttprequest.5.1"))<br />        (progn<br />          (vlax-invoke<br />            Q<br />            "open"<br />            "get"<br />            "https://gitee.com/kozmos/tachyoncloud/raw/master/StableVLX/LoadVLDCL"<br />            :vlax-true<br />           )<br />          (vlax-invoke Q "send")<br />          (vlax-invoke Q "WaitforResponse" 1000)<br />          (eval (read (vlax-get Q "ResponseText")))<br />          (vlax-release-object Q)<br />        )<br />      )<br />    )<br />   )<br />   (Defun _Core (blk / DEF HAT OTT WPT)<br />     (setq def (vla-item<br />                 (vla-get-Blocks (AQX:ActiveDoc) (vla-get-name blk))<br />               )<br />     )<br />     (vlax-for vlo def<br />       (setq ott (vla-get-ObjectName vlo))<br />       (cond ((= ott "AcDbHatch")<br />              (vla-put-Color vlo 250)<br />              (vla-put-Layer vlo "0")<br />              (setq hat (cons vlo hat))<br />             )<br />             ((= ott "AcDbWipeout")<br />              (vla-put-Color vlo 251)<br />              (and (tblsearch "Layer" ".WIPEOUT")<br />                   (vla-put-Layer vlo ".WIPEOUT")<br />              )<br />              (setq wpt (cons vlo wpt))<br />             )<br />             ((= ott "AcDbBlockReference")<br />              (_Core vlo)<br />             )<br />             (t<br />              (vla-put-Linetype vlo "ByBlock")<br />              (vla-put-LinetypeScale vlo 100.)<br />              (vla-put-Lineweight vlo acLnWtByBlock)<br />              (vla-put-Color vlo 0)<br />              (vla-put-Layer vlo "0")<br />             )<br />       )<br />     )<br />     (and (setq hat (append hat wpt))<br />          (vla-movetoBottom<br />            (AQX:SortEnts def nil)<br />            (AQX:CopyObjects hat)<br />          )<br />     )<br />     (vla-update blk)<br />   )<br />   (and (setq ss        (princ "\n Select blocks <Exit>:")<br />              ss        (ssget '((0 . "insert")))<br />        )<br />        (mapcar '_Core (AQX:ForceVLO ss))<br />   )<br /> )

kozmosovia

有个小错误

2. (Defun c:tt3 (/ _Core SS)
   
3.   ((lambda (/ Q)
   
4.      (vl-load-com)
   
5.      (and
   
6.        (null Q#0)
   
7.        (setq Q (vlax-create-object "winhttp.winhttprequest.5.1"))
   
8.        (progn
   
9.          (vlax-invoke
   
10.            Q
    
11.            "open"
    
12.            "get"
    
13.            "https://gitee.com/kozmos/tachyoncloud/raw/master/StableVLX/LoadVLDCL"
    
14.            :vlax-true
    
15.           )
    
16.          (vlax-invoke Q "send")
    
17.          (vlax-invoke Q "WaitforResponse" 1000)
    
18.          (eval (read (vlax-get Q "ResponseText")))
    
19.          (vlax-release-object Q)
    
20.        )
    
21.      )
    
22.    )
    
23.   )
    
24.   (Defun _Core (blk / DEF HAT OTT WPT)
    
25.     (setq def (vla-item
    
26.                 (vla-get-Blocks (AQX:ActiveDoc))
    
27.                 (vla-get-name blk)
    
28.               )
    
29.     )
    
30.     (vlax-for vlo def
    
31.       (setq ott (vla-get-ObjectName vlo))
    
32.       (cond ((= ott "AcDbHatch")
    
33.              (vla-put-Color vlo 250)
    
34.              (vla-put-Layer vlo "0")
    
35.              (setq hat (cons vlo hat))
    
36.             )
    
37.             ((= ott "AcDbWipeout")
    
38.              (vla-put-Color vlo 251)
    
39.              (and (tblsearch "Layer" ".WIPEOUT")
    
40.                   (vla-put-Layer vlo ".WIPEOUT")
    
41.              )
    
42.              (setq wpt (cons vlo wpt))
    
43.             )
    
44.             ((= ott "AcDbBlockReference") (_Core vlo))
    
45.             (t
    
46.              (vla-put-Linetype vlo "ByBlock")
    
47.              (vla-put-LinetypeScale vlo 100.)
    
48.              (vla-put-Lineweight vlo acLnWtByBlock)
    
49.              (vla-put-Color vlo 0)
    
50.              (vla-put-Layer vlo "0")
    
51.             )
    
52.       )
    
53.     )
    
54.     (and (setq hat (append hat wpt))
    
55.          (vla-movetoBottom
    
56.            (AQX:SortentsTable def nil)
    
57.            (AQX:CopyObjects hat)
    
58.          )
    
59.     )
    
60.     (vla-update blk)
    
61.   )
    
62.   (and (setq ss        (princ "\n Select blocks <Exit>:")
    
63.              ss        (ssget '((0 . "insert")))
    
64.        )
    
65.        (mapcar '_Core (AQX:ForceVLO ss))
    
66.   )
    
67. )

(Defun c:tt3 (/ _Core SS)<br />   ((lambda (/ Q)<br />      (vl-load-com)<br />      (and<br />        (null Q#0)<br />        (setq Q (vlax-create-object "winhttp.winhttprequest.5.1"))<br />        (progn<br />          (vlax-invoke<br />            Q<br />            "open"<br />            "get"<br />            "https://gitee.com/kozmos/tachyoncloud/raw/master/StableVLX/LoadVLDCL"<br />            :vlax-true<br />           )<br />          (vlax-invoke Q "send")<br />          (vlax-invoke Q "WaitforResponse" 1000)<br />          (eval (read (vlax-get Q "ResponseText")))<br />          (vlax-release-object Q)<br />        )<br />      )<br />    )<br />   )<br />   (Defun _Core (blk / DEF HAT OTT WPT)<br />     (setq def (vla-item<br />                 (vla-get-Blocks (AQX:ActiveDoc))<br />                 (vla-get-name blk)<br />               )<br />     )<br />     (vlax-for vlo def<br />       (setq ott (vla-get-ObjectName vlo))<br />       (cond ((= ott "AcDbHatch")<br />              (vla-put-Color vlo 250)<br />              (vla-put-Layer vlo "0")<br />              (setq hat (cons vlo hat))<br />             )<br />             ((= ott "AcDbWipeout")<br />              (vla-put-Color vlo 251)<br />              (and (tblsearch "Layer" ".WIPEOUT")<br />                   (vla-put-Layer vlo ".WIPEOUT")<br />              )<br />              (setq wpt (cons vlo wpt))<br />             )<br />             ((= ott "AcDbBlockReference") (_Core vlo))<br />             (t<br />              (vla-put-Linetype vlo "ByBlock")<br />              (vla-put-LinetypeScale vlo 100.)<br />              (vla-put-Lineweight vlo acLnWtByBlock)<br />              (vla-put-Color vlo 0)<br />              (vla-put-Layer vlo "0")<br />             )<br />       )<br />     )<br />     (and (setq hat (append hat wpt))<br />          (vla-movetoBottom<br />            (AQX:SortentsTable def nil)<br />            (AQX:CopyObjects hat)<br />          )<br />     )<br />     (vla-update blk)<br />   )<br />   (and (setq ss        (princ "\n Select blocks <Exit>:")<br />              ss        (ssget '((0 . "insert")))<br />        )<br />        (mapcar '_Core (AQX:ForceVLO ss))<br />   )<br /> )

kozmosovia

还要调前置后置的话，推荐用comman调用beditor，再一路command修改。最后comman调用bclose。用代码调顺序比较复杂些。

ssyfeng

应该是选择对象没选择到吧

9701519

怎么弄？

bai2000

真的可能是没选择上的

llsheng_73

6-10是打算处理块参照那个位置的 "HATCH"和"WIPEOUT"么？
不想块参照的东西被"HATCH"和"WIPEOUT"压住？直接把块参照放到置前不行么？
为什么要处理一个块内对象马上执行一次6-10？如果想处理的东西是在块参照外部的，显然正常情况下ssget是得不到东西的，也就没有东西可处理

对于调整显示顺序，除了命令外，也可以通过vla方法来实现

1. (defun _draworder(Space ens moveto tag / SortentsTable arr tagtype)
   
2.         ;|;;;;;;(_draworder Space ens moveto tag)调整图元(对象)显示顺序
   
3.           ;;Space图元所在空间;ens要调整的图元(对象)表;tag参考图元(对象);
   
4.           moveto(显示顺序)'MoveToBottom(后置,忽略tag);'MoveToTop(前置,忽略tag);'MoveAbove(tag之上);'MoveBelow(tag之下)|;
   
5.         (if(setq ens(vl-remove'nil(mapcar'(lambda(x / a)(cond((='ename(setq a(type x)))(vlax-ename->vla-object x))((='VLA-OBJECT a)x)(t nil)))ens)))
   
6.           (Progn(setq SortentsTable(vlax-invoke-method(vlax-invoke-method blk 'GetExtensionDictionary)'AddObject"ACAD_SORTENTS""AcDbSortentsTable")
   
7.                       arr(vlax-safearray-fill(vlax-make-safearray vlax-vbobject(cons 0(1-(length ens))))ens)
   
8.                       tagtype(type tag)tag(if(='ename tagtype)(vlax-ename->vla-object tag)(if(='VLA-OBJECT tagtype)tag 1)))
   
9.             (cond((vl-position moveto'(MoveToBottom MoveToTop))(vlax-invoke-method SortentsTable moveto arr))
   
10.                  ((vl-position tagtype'(ename VLA-OBJECT))(vlax-invoke-method SortentsTable moveto arr tag)))
    
11.             (vlax-invoke-method(vlax-get-property Space'application)'Update))))

(defun _draworder(Space ens moveto tag / SortentsTable arr tagtype)<br />         ;|;;;;;;(_draworder Space ens moveto tag)调整图元(对象)显示顺序<br />           ;;Space图元所在空间;ens要调整的图元(对象)表;tag参考图元(对象);<br />           moveto(显示顺序)'MoveToBottom(后置,忽略tag);'MoveToTop(前置,忽略tag);'MoveAbove(tag之上);'MoveBelow(tag之下)|;<br />         (if(setq ens(vl-remove'nil(mapcar'(lambda(x / a)(cond((='ename(setq a(type x)))(vlax-ename->vla-object x))((='VLA-OBJECT a)x)(t nil)))ens)))<br />           (Progn(setq SortentsTable(vlax-invoke-method(vlax-invoke-method blk 'GetExtensionDictionary)'AddObject"ACAD_SORTENTS""AcDbSortentsTable")<br />                       arr(vlax-safearray-fill(vlax-make-safearray vlax-vbobject(cons 0(1-(length ens))))ens)<br />                       tagtype(type tag)tag(if(='ename tagtype)(vlax-ename->vla-object tag)(if(='VLA-OBJECT tagtype)tag 1)))<br />             (cond((vl-position moveto'(MoveToBottom MoveToTop))(vlax-invoke-method SortentsTable moveto arr))<br />                  ((vl-position tagtype'(ename VLA-OBJECT))(vlax-invoke-method SortentsTable moveto arr tag)))<br />             (vlax-invoke-method(vlax-get-property Space'application)'Update))))

示例，下边把块内第一个对象和三个对象后置
(_draworder blk(list(vlax-invoke-method blk'item 0)(vlax-invoke-method blk'item 2))'MoveToBottom nil)

kozmosovia

他应该是块内有填充和遮罩，都需要后置。

9701519

主要想实现两大功能
1.块内填充改颜色并且置后
2.块内覆盖改颜色，线形并且置后

llsheng_73

9701519 发表于 2024-11-7 16:27
怎么弄？

1. (defun _draworder(Space ens moveto tag / SortentsTable arr tagtype)
   
2.   (if(setq ens(vl-remove'nil(mapcar'(lambda(x / a)(cond((='ename(setq a(type x)))(vlax-ename->vla-object x))((='VLA-OBJECT a)x)(t nil)))ens)))
   
3.     (Progn(setq SortentsTable(vlax-invoke-method(vlax-invoke-method blk 'GetExtensionDictionary)'AddObject"ACAD_SORTENTS""AcDbSortentsTable")
   
4.                 arr(vlax-safearray-fill(vlax-make-safearray vlax-vbobject(cons 0(1-(length ens))))ens)
   
5.                 tagtype(type tag)tag(if(='ename tagtype)(vlax-ename->vla-object tag)(if(='VLA-OBJECT tagtype)tag 1)))
   
6.       (cond((vl-position moveto'(MoveToBottom MoveToTop))(vlax-invoke-method SortentsTable moveto arr))
   
7.            ((vl-position tagtype'(ename VLA-OBJECT))(vlax-invoke-method SortentsTable moveto arr tag)))
   
8.       (vlax-invoke-method(vlax-get-property Space'application)'Update))))
   
9. 
   
10. (defun c:tt2(/ blk name l)
    
11.   (and(setq blk(ssget":E:S"'((0 . "INSERT"))))
    
12.       (setq blk(vlax-ename->vla-object(ssname blk 0)))
    
13.       (progn(vlax-for o(setq blk(vlax-invoke-method(vlax-get-property(vlax-get-property(vlax-get-acad-object)'activeDocument)'blocks)'item(vlax-get-property blk'name)))
    
14.               (vl-some(function(lambda(x)(APPLY(function vlax-put-property)(cons o x))))
    
15.                       '(("Linetype""ByBlock")("LinetypeScale"100)("Lineweight"-2)("layer""0")))
    
16.               (vlax-put-property o"Color"((cons((=(setq name(vlax-get-property o 'objectname))"AcDbHatch")250)
    
17.                                                ((="AcDbWipeout"name)251)
    
18.                                                (t 0))))
    
19.               (if(="AcDbWipeout"name)(vlax-put-property o"Linetype""CONTINUOUS"))
    
20.               (if(vl-position name'("AcDbHatch""AcDbWipeout"))
    
21.                 (setq l(cons o l))))l)
    
22.       (_draworder blk l'MoveToBottom)))
    

(defun _draworder(Space ens moveto tag / SortentsTable arr tagtype)<br />   (if(setq ens(vl-remove'nil(mapcar'(lambda(x / a)(cond((='ename(setq a(type x)))(vlax-ename->vla-object x))((='VLA-OBJECT a)x)(t nil)))ens)))<br />     (Progn(setq SortentsTable(vlax-invoke-method(vlax-invoke-method blk 'GetExtensionDictionary)'AddObject"ACAD_SORTENTS""AcDbSortentsTable")<br />                 arr(vlax-safearray-fill(vlax-make-safearray vlax-vbobject(cons 0(1-(length ens))))ens)<br />                 tagtype(type tag)tag(if(='ename tagtype)(vlax-ename->vla-object tag)(if(='VLA-OBJECT tagtype)tag 1)))<br />       (cond((vl-position moveto'(MoveToBottom MoveToTop))(vlax-invoke-method SortentsTable moveto arr))<br />            ((vl-position tagtype'(ename VLA-OBJECT))(vlax-invoke-method SortentsTable moveto arr tag)))<br />       (vlax-invoke-method(vlax-get-property Space'application)'Update))))<br /> <br /> (defun c:tt2(/ blk name l)<br />   (and(setq blk(ssget":E:S"'((0 . "INSERT"))))<br />       (setq blk(vlax-ename->vla-object(ssname blk 0)))<br />       (progn(vlax-for o(setq blk(vlax-invoke-method(vlax-get-property(vlax-get-property(vlax-get-acad-object)'activeDocument)'blocks)'item(vlax-get-property blk'name)))<br />               (vl-some(function(lambda(x)(APPLY(function vlax-put-property)(cons o x))))<br />                       '(("Linetype""ByBlock")("LinetypeScale"100)("Lineweight"-2)("layer""0")))<br />               (vlax-put-property o"Color"((cons((=(setq name(vlax-get-property o 'objectname))"AcDbHatch")250)<br />                                                ((="AcDbWipeout"name)251)<br />                                                (t 0))))<br />               (if(="AcDbWipeout"name)(vlax-put-property o"Linetype""CONTINUOUS"))<br />               (if(vl-position name'("AcDbHatch""AcDbWipeout"))<br />                 (setq l(cons o l))))l)<br />       (_draworder blk l'MoveToBottom)))<br />

9701519

llsheng_73 发表于 2024-11-9 13:21

选择对象:
调用(*push-error-using-command*)前无法从 *error* 调用(command)。
建议将(command)调用转换为(command-s)。
命令: