连接图案填充
是否有人有lisp可以选择多个图案填充并在其位置创建一个图案填充？ Civil 3D中没有“图案填充合并”选项？ 我找不到评论备注，您知道AutoCAD中的“图案填充合并”选项吗？我在Architecture 2012工作，如果有这样的工具，我会非常感兴趣。谢谢 给你一个开始（伍德曼78或布拉茨，男孩）
这适用于非关联图案填充。。。没有弧。
修改它以处理所有图案填充应该不需要太多。
为了确保没有选择不同的图案，它将首先提示输入填充图案，然后提示选择要合并的所有图案填充。
;-----------------------------------------------
;; ø Remove_nth ø(Lee Mac) ;;
;; ~ Removes the nth item in a list.;;
(defun Remove_nth (i lst / j)
(setq j -1)
(vl-remove-if
(function
(lambda (x)
(eq i (setq j (1+ j))))) lst))
;-----------------------------------------------
;; massoc (Jaysen Long) ;;
;; 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 n entinfo ptlist pickpntlst entlist 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.")))
(while (not ss) (princ "Select hatch entities to merge:")(setq ss (ssget '((0 . "HATCH")))))
(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)
(repeat (sslength ss)
(setq n -1 newlist nil)
(setq entinfo (entget (ssname ss (setq i (1+ i)))))
(setq ptlist (cdr (massoc 10 entinfo)))
(setq pickpntlst (append pickpntlst (list (last ptlist))))
(repeat (cdr (assoc 93 entinfo))(setq newlist (append newlist (list (nth (setq n (1+ n)) ptlist)))))
(setq entlist (append (append (mapcar '(lambda (x) (assoc x entinfo)) '(92 72 73 93)) newlist)(list (assoc 97 entinfo))))
(setq MergedHatchList (append MergedHatchlist entlist))
(entdel (ssname ss i))
)
(setq MergedHatchList
(append MergedHatchList
(append
(mapcar '(lambda (x) (assoc x hentinfo)) '(75 76 52 41 77 78 53 43 44 45 46 79 47))
(cons (cons 98 (sslength ss)) pickpntlst))))
(entmake MergedHatchList)
)
MH\u MERGE\u图案填充。lsp 这是另一个可以玩的。。这适用于任何图案填充。。失去关联性。。
(defun c:MH ( / hentinfo ss i 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.")))
(while (not ss) (princ "\nSelect hatch entities to merge:")(setq ss (ssget '((0 . "HATCH")))))
(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)
(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))))
(entmake MergedHatchList)
)
这将合并选定图案填充并保持关联性。
享受
MH\U合并图案填充。lsp Lisp在以下情况下不起作用：填充图案是由选定对象创建的图案填充，要合并的图案填充图元是由拾取点创建的图案填充。
页:
[1]