社区 › AutoLISP/Visual LISP 编程技术 › （已解决）块的修改问题主要想实现两大功能 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))
)
)

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

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))
[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif         (vla-movetoBottom
[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif         (AQX:SortentsTable def nil)
[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif         (AQX:CopyObjects hat)
[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif         )
[*]http://bbs.mjtd.com/source/plugin/imc_colorcode/images/jssc_none.gif    )

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

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

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

yefei812678 发表于 2024-11-14 08:25:11

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

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