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

9701519 · 发表于 2024-11-11 16:49:24

哪里更改 (command)调用转换为(command-s)。

kozmosovia · 发表于 2024-11-11 19:37:21

那代码很多错误，别用

kozmosovia · 发表于 2024-11-12 16:46:55

给你个选择图块的

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

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

9701519 · 发表于 2024-11-12 18:28:00

kozmosovia 发表于 2024-11-12 16:46
给你个选择图块的

加载出现 AutoCAD 变量设置被拒绝: "cmdecho" nil

kozmosovia · 发表于 2024-11-12 18:52:13

有个小错误

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

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

9701519 · 发表于 2024-11-12 20:32:30

kozmosovia 发表于 2024-11-12 18:52
有个小错误

有个问题，遮罩不是最后面反而填充是最后面

kozmosovia · 发表于 2024-11-12 21:18:26

本帖最后由 kozmosovia 于 2024-11-12 23:09 编辑

把

(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)
         )
   )
)

9701519 · 发表于 2024-11-12 23:48:52

大神！！！！！！！！！！

yefei812678 · 发表于 7 天前

谢谢分享谢谢分享谢谢分享谢谢分享

账号		自动登录	找回密码
密码			注册

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