求HATCH边界然后删除HATCH实体

Lisphk · 发表于 2016-12-12 16:40:10

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun c:PHB (/ oldce sset cnt obj)
  (setq OLDCE (getvar "cmdecho"))
  (setq OLDColor (getvar "CeColor"))
  (setq OLDLayer (getvar "Clayer"))
  (setvar "cmdecho" 0)
  (princ "\nSelect Hatch Objects: ")
  (setq sset (ssget ":l" '((0 . "hatch"))))
  (setq CNT -1)
  (while (setq OBJ (ssname SSET (setq CNT (1+ CNT))))
    (setvar 'clayer (cdr (assoc 8 (setq ent (entget OBJ)))))
    (setvar 'cecolor
            (if        (setq clr (assoc 62 ent))
              (itoa (cdr clr))
              "BYLAYER"
            )
    )
    (command "_hatchedit" OBJ "_b" "_p" "_y")
    (entdel OBJ)
  )
  (setvar "cmdecho" OLDCE)
  (setvar "CeColor" OLDColor)
  (setvar "CLayer" OLDLayer)
  (princ)
)

434939575 · 发表于 2017-5-18 10:31:44

这个挺强大的！

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

[每日一码] 求HATCH边界然后删除HATCH实体

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。