填充合并-找的
本帖最后由 myjping 于 2014-8-6 14:02 编辑;;; massoc (Jaysen Long) ;;
;;; Minor Modification by Jvillarreal ;;
;;; Extracts info from list by key ;;
(defun massoc (key alist / x nlist)
(foreach x alist
(if (eq key (car x))
(setq nlist (cons x nlist))
)
)
(reverse nlist)
)
;;; defun
(defun c:mh(/ hentinfo ss i ent ent# seedpt# entinfo entinfo2 ent# seedpt# seedpts MergedHatchList)
;(while (/= (cdr (assoc 0 hentinfo)) "HATCH")
; (setq hentinfo (car (entsel "\nSelect Hatch Pattern to use:")))
; (If hentinfo
; (setq hentinfo (entget hentinfo))
; (princ "\nMissed. Try again.")
; )
;)
(princ "\n选择多个要合并的填充样式，第一个对象将视为源对象:")
(setq ss (ssget '((0 . "HATCH"))))
(if (andss (>(sslength ss)1))
(progn
;(princ "\n?*********")
(setq hentinfo (entget(ssnamess 0)))
(setq MergedHatchList (list (cons 0 "HATCH") (cons 100 "AcDbEntity") (assoc 8 hentinfo)(cons 100 "AcDbHatch")
(assoc 10 hentinfo) (assoc 210 hentinfo) (assoc 2 hentinfo) (assoc 70 hentinfo)
(assoc 71 hentinfo) (cons 91 (sslength ss))
)
i -1
seedpt# 0
ent# 0
)
(if (assoc 62 hentinfo) (setq MergedHatchList (append MergedHatchList (list(assoc 62 hentinfo)) )))
(repeat (sslength ss)
(setq n -1
entinfo (entget (ssname ss (setq i (1+ i))))
entinfo2 (member (assoc 92 entinfo) entinfo)
entinfo2 (reverse (cdr (member (assoc 75 entinfo2) (reverse entinfo2))))
ent# (+ ent# (cdr (assoc 91 entinfo)))
seedpt# (+ seedpt# (cdr (assoc 98 entinfo)))
seedpts (append
seedpts
(cdr (member (assoc 98 entinfo) entinfo))
)
MergedHatchList (append
MergedHatchList
entinfo2
)
)
(entdel (ssname ss i))
)
(setq MergedHatchList (subst
(cons 91 ent#)
(assoc 91 MergedHatchList)
MergedHatchList
)
MergedHatchList (append
MergedHatchList
(append
(reverse (cdr (member (assoc 98 hentinfo) (reverse (member (assoc 75 hentinfo) hentinfo)))))
(cons (cons 98 seedpt#) seedpts)
)
)
)
(if (= (cdr (assoc 71 hentinfo)) 1)
(setq MergedHatchList (append
MergedHatchList
'((-3 ("ACAD" (1010 0.0 0.0 0.0))))
)
)
)
(entmake MergedHatchList)
(setq ent (entlast))
(if (= (cdr (assoc 71 hentinfo)) 1)
(mapcar
'(lambda (x / entlist)
(setq entlist (entget (cdr x)))
(entmod (subst
(cons 330 ent)
(assoc 330 entlist)
entlist
)
)
)
(massoc 330 MergedHatchList)
)
)
)
(princ "\n选择集为空或只有一个填充对象")
)
(princ)
)
感谢楼上大神，我的困惑终于解决了，附上插件。 感谢 myjping chlshw 发表于 2016-4-15 11:26
感谢楼上大神，我的困惑终于解决了，附上插件。
你人品有问题，你的附件还是楼主的内容。骗子:@ 大师怎么使用的啊？我选了2区域个相同种类的填充图案。命令后图案全消失了。比较迷惑。 434939575 发表于 2014-8-5 23:32 static/image/common/back.gif
大师怎么使用的啊？我选了2区域个相同种类的填充图案。命令后图案全消失了。比较迷惑。
看这里 http://autocadtips.wordpress.com/2011/11/23/autolisp-merge-hatches-join-hatches/ 好的 本帖最后由 spp_wall 于 2014-8-6 09:18 编辑
我选了2区域个相同种类的填充图案。命令后图案全消失了。比较迷惑。
LZ的链接打开也没东西！！！ 本帖最后由 spp_wall 于 2014-8-6 11:47 编辑
好像理解错意思了
程序是 把一个填充刷成另一个填充在把2个填充合并
我还以为是2个不同的填充图案合并成一个 填充图案 非常不错，以前搞了好久这个程序，没有搞定，谢谢大师，这个很常用到的 谢谢分享。 感谢 myjping 分享程序! 不能批量没用~~~~~~~~~~~~~也还是顶一个