另类"继承填充”，改变你的填充传统

spp_wall · 发表于 2016-4-11 20:18

明经币不值几个钱吧！！！！什么都没直接给钱我也不想买！！！

77077 · 发表于 2016-4-12 22:34

你们这些人太坏了，好歹给楼主点继续写下去的勇气呀~

tangjunasd58 · 发表于 2016-4-12 22:46

;;;
;;;继承填充 by ucuc2003
(defun C:JCTC (/ ent ss tc_name tcm tcb tcj tc_col)
(setvar "cmdecho" 0)
(princ "继承填充或JCTC（先选择填充，再选择要填充的区域）")
(setq ent (entsel "\n选择填充对象<退出>:"))
(setq tcm (cdr (assoc 2 (entget (car ent)))));获取填充图案的名称
(setq tc_name (cdr (assoc 8 (entget (car ent)))));获取填充图案的图层名
(if (= tcm "SOLID")
(setvar "hpname" tcm)
(progn
(setq tcb (cdr (assoc 41 (entget (car ent)))));获取填充图案的比例
(setq tcj (cdr (assoc 52 (entget (car ent)))));获取填充图案的角度（这个值是以弧度返回的）
(setq tc_col (cdr (assoc 62 (entget (car ent)))));获取填充图案的颜色
(setvar "hpname" tcm)
(setvar "hpscale" tcb)
(setvar "hpang" tcj)
)
)
(while (JCTC_z))
(princ)
)

(defun JCTC_z ()
  (setvar "cmdecho" 0)
  (defun *Error* (msg)
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,*EXIT*,")))
   (princ))
  );defun *Error*
  (setvar "measurement" 1)
  (setvar "measureinit" 1)
  (princ "\n请选择填充区域：(提示:空选则为拾取内部点填充）")
  (if (setq ss (ssget))
   (command "bhatch" "s" ss "" "")
   (progn
      (princ "\n请拾取填充内部点：")
      (command "bhatch" pause pause)
   );progn
);if
  (command "_.undo" "_group")
  (command "change" (entlast) "" "P" "la" tc_name ""
         "change" (entlast) "" "P" "c" "bylayer" "")
  (command "_.undo" "_end")
  (princ)
);defun

不知道是不这个，我是从别的网站下来的

彳余 · 发表于 2016-4-13 08:23

这是什么鬼，多的话都不想说了

尘缘一生 · 发表于 2016-4-14 07:38

本帖最后由尘缘一生于 2016-4-14 08:24 编辑

tryhi 发表于 2016-4-11 13:25
看楼主的发言好像是楼主写了个自认为不错的程序，应该是有了进步，购买一下表示鼓励，瞄了一眼发表几句评价 ...

这段后边代码，是在93年，CAD10版时候写的，如今23年了，你那时候有现在-HATCH特性边界吗？那时候的填充是解决不了问题的，看到本坛有继承填充帖子，我改造了它，因为我一直画图，我知道怎么好用，怎么省击键，甚至你少一个击键就是好代码，你多一个击键，就是垃圾。

我刚才试用了下CAD2010版继承特性，确实能完成，原始命令太杂，一样可以写个lisp整合，没人那么用，谁画图这么用，效率太低。

1：确实，弧线问题需要关闭F3,鼠标拟合，此时还在程序中。
2：程序要最后关闭F3，后边加句话，仅是乒乓开关而已。
3：不画图之人，无权评价。专为不闭合区域填充苦恼问题20年思索。

77077 · 发表于 2016-4-14 10:34

本帖最后由 77077 于 2016-4-14 10:37 编辑

不是没画图，只不过专业不同，很少或不会用到你这个程序，再说了，你原先是设置为收费的，没必要什么都收费吧，小东西嘛改送就送了。
今天才看到你的代码，顺便帮你调整了一下代码：
1.增加程序判断，选不到填充就退出。
2.增加捕捉的储存与还原。
3.增加即时显示。

顺便问下，如果遇到多义线里面含有圆弧，你打算怎么办？

;;---------继承填充------------------------------------------------------------
(defun c:jctc (/ os a pt0 pt1 lis lis1 ent tcm tcb tcj)
(princ "继承填充")
(setq os (getvar "OSMODE"));储存当前捕捉
(if (and (setq ent (entget(car(entsel "\n选择点选一个填充图案<退出>:"))))
(= (strcase(cdr (assoc 0 ent))) "HATCH")
);选择到物体且物体是个填充时继续，否则退出
(progn
(setvar "OSMODE" 4327)
(setq tcm (cdr (assoc 2 ent))
tcb (cdr (assoc 41 ent))
tcj (cdr (assoc 52 ent))
tcj (/ (* 180 tcj) pi)
)
(setq pt1 (getpoint "\n请给出围区第一点:?"))
(command "PLINE" pt1 "W" 0 0)
;预览显示围合范围
(while (setq pt1 (getpoint pt1 "\n请逐点给出围区下面各点:?"))
(command pt1)
)
(command "c" "")
(setq a (entlast))
(command "HATCH" tcm tcb tcj a "")
(entdel a)
(setvar "OSMODE" os);还原捕捉
)
)
(princ)
)

jltx123456 · 发表于 2016-4-14 11:18

画图画了２３年，算不思进取吗？

woistc · 发表于 2016-4-14 16:05

20年思索
隆隆而够~

尘缘一生 · 发表于 2016-4-15 11:19

77077 发表于 2016-4-14 10:34
不是没画图，只不过专业不同，很少或不会用到你这个程序，再说了，你原先是设置为收费的，没必要什么都收费 ...

代码完善了，我是结构专业，平时填充不外乎：混凝土、砖墙、轻质材料等，范围规整，我遇到圆弧，不规整的范围，就直接关闭F3，鼠标拟合过去，其他一直没想到好办法，一直这么用，那也比非要个闭合边界强得多，提高效率。

xman00 · 发表于 2019-4-23 13:23

非常感谢楼主的努力，看了各位的发言，特别尝试了下，对于不闭合的情况下，使用自动的hatch命令，选择区域后，得到的填充效果与楼主程序的效果完全一致。而对于此等情况，楼主的程序需要多次选点点击，hatch命令选择外框（不闭合）一次就可以了。
或许表达得不对，请楼主审视哈

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

[源码] 另类"继承填充”，改变你的填充传统

点评

点评

评分