填充合并-找的

myjping

;;; 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 (and  ss (>(sslength ss)1))
   
   (progn  
   ;(princ "\n?*********")
  (setq hentinfo (entget(ssname  ss 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)
)

chlshw

感谢楼上大神，我的困惑终于解决了，附上插件。

LIULISHENG

感谢 myjping

zhangkui9070

chlshw 发表于 2016-4-15 11:26
感谢楼上大神，我的困惑终于解决了，附上插件。

你人品有问题，你的附件还是楼主的内容。骗子

434939575

大师怎么使用的啊？我选了2区域个相同种类的填充图案。命令后图案全消失了。比较迷惑。

yoyoho

434939575 发表于 2014-8-5 23:32
大师怎么使用的啊？我选了2区域个相同种类的填充图案。命令后图案全消失了。比较迷惑。

看这里 http://autocadtips.wordpress.com ... tches-join-hatches/

434939575

好的

spp_wall

我选了2区域个相同种类的填充图案。命令后图案全消失了。比较迷惑。

LZ的链接打开也没东西！！！

spp_wall

好像理解错意思了
程序是 把一个填充刷成另一个填充  在把2个填充合并

我还以为是2个不同的填充图案合并成一个 填充图案

lidaxiu

非常不错，以前搞了好久这个程序，没有搞定，谢谢大师，这个很常用到的

恕放之生命

谢谢分享。

yoyoho

感谢 myjping 分享程序!

flytoday

不能批量没用~~~~~~~~~~~~~也还是顶一个