明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 686|回复: 6

【K:Hatch2BD】生成填充边界并返回图元表

  [复制链接]
发表于 2024-2-22 23:10 | 显示全部楼层 |阅读模式
本帖最后由 kucha007 于 2024-2-24 15:03 编辑

此函数修改自论坛,最早好像是飞诗写的,后来小菜也有修改。功能类似CAD自带的HATCHGENERATEBOUNDARY

程序我也做了点调整,本来是为了版本通用,不打算使用VL函数,但排序还是跑不了......

所以看起来只是椭圆用了entmakeX生成,变量改名,增加椭圆是否完整的判断,加了一些注释。

目前直线弧线合并数据再生成多段线不是很完美,还在摸索。
填充重新关联边界:此函数是利用了重新生成+格式刷,容易出错。还想试试97和330,但目前测试未通过。
总之欢迎大家一起来玩~

函数说明:
(K:Hatch2BD 填充选择集 填充层(OR当前层)? 重生成填充使其关联边界?)

返回:
(list 边界线选择集 边界线图元表)

参考用法一:
  1. (if (setq SSH (ssget '((0 . "HATCH"))))
  2.     (princ (K:Hatch2BD SSH Nil Nil))
  3. )
参考用法二:
  1. (if (setq SSH (ssget '((0 . "HATCH"))))
  2.     (command "_.ERASE"  (car (K:Hatch2BD SSH Nil Nil)) pause "" )
  3. )

参考资料备份一下,有时间再看看:
https://help.autodesk.com/view/OARX/2024/CHS/?guid=GUID-04E0FB2D-919A-46A0-A715-541A4AA8CB1A
https://help.autodesk.com/view/OARX/2024/CHS/?guid=GUID-4CA06494-CDFF-46FA-9E1D-A0E8220F69F4



本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

评分

参与人数 2明经币 +2 收起 理由
zhoupeng220 + 1 很给力!
ssyfeng + 1 赞一个!

查看全部评分

 楼主| 发表于 2024-3-24 23:01 | 显示全部楼层
本帖最后由 kucha007 于 2024-3-24 23:02 编辑

做了个针对实体的子函数:关联重做用处不大删除了,有兴趣的小伙伴自行添加
  1. ;生成填充实体的并返回图元表@Kucha:(K:GetHatchBD 填充实体 边界层(在填充层?))
  2. (defun K:GetHatchBD (En OriLay
  3.                           / K:GetEnDXF K:Arc->Bulge K:LineArc2PL K:ElAng->Par  
  4.                           BoundLst ent HLay PathNum PathBD1 PathBD2
  5.                           PathTyp EdgTyp Cvt2PLst DATA VtxNum HasBlg PtLst IsClsd TgtEn
  6.                           StaAng EndAng ISCCLK ERatio
  7.                           KnpNum CtrNum Front KnpLst CtrLst
  8.                           )
  9.   (progn ;基础函数
  10.       ;获取实体DXF组码值
  11.       (defun K:GetEnDXF (key en) (cdr (assoc key en)))
  12.       ;圆弧数据转多段线数据@LEEMAC
  13.       (defun K:Arc->Bulge (Cen Rad StaAng EndAng )
  14.         (mapcar 'cons '(10 42 10)
  15.             (list
  16.               (polar Cen StaAng Rad)
  17.               ((lambda (a) (/ (sin a) (cos a)))
  18.                 (/ (rem (+ pi pi (- EndAng StaAng)) (+ pi pi)) 4.0)
  19.               )
  20.               (polar Cen EndAng Rad)
  21.             )
  22.         )
  23.       )
  24.       ;直线和圆弧转多段线数据处理@Kucha
  25.       (defun K:LineArc2PL (OldLst / Fun NewLst Tmp BseLst BseVar Pos item)
  26.           ;|
  27.             (setq OldLst
  28.               (list
  29.                 (list
  30.                   (list 10 -1474.19 -1780.16 0.0)
  31.                   (list 42 0.0)
  32.                   (list 10 -1423.16 -1780.16 0.0)
  33.                 )
  34.                 (list
  35.                   (list 10 -1423.16 -1780.16 0.0)
  36.                   (list 42 0.0)
  37.                   (list 10 -1423.16 -1729.13 0.0)
  38.                 )
  39.                 (list
  40.                   (list 10 -1474.19 -1729.13 0.0)
  41.                   (list 42 0.0)
  42.                   (list 10 -1474.19 -1780.16 0.0)
  43.                 )
  44.                 (list
  45.                   (list 10 -1423.16 -1729.13 0.0)
  46.                   (list 42 0.0)
  47.                   (list 10 -1474.19 -1729.13 0.0)
  48.                 )
  49.               )
  50.             )
  51.           |;
  52.           (setq OldLst (vl-sort OldLst '(lambda (a b) (< (cadr (car a)) (cadr (last b))))))
  53.           (setq Fun (lambda (a b)
  54.                       (if (equal (Last a) (caar b) 0.01);第一项的最后等于第二项的第一
  55.                           (progn
  56.                             (setq Tmp (append Tmp (cdar b)))
  57.                             (Fun Tmp (cdr b))
  58.                           )
  59.                           (list b Tmp)
  60.                       )
  61.                   )
  62.           )
  63.           (if OldLst
  64.               (cons
  65.                   (append
  66.                     (car OldLst)
  67.                     (cadr (setq NewLst (Fun (car OldLst) (cdr OldLst))))
  68.                   )
  69.                   (K:LineArc2PL (car NewLst))
  70.               )
  71.           )
  72.       )
  73.       ;椭圆真实角度转参数@edata
  74.       (defun K:ElAng->Par (Ang Ratio)
  75.           ;(K:ElAng->Par 真实弧度 短长轴比率)
  76.           (if (and (> Ang (* pi 0.5)) (<= Ang (* pi 1.5)))
  77.               (- (atan (/ (/ (sin Ang) (cos Ang)) Ratio)) pi);当角度值90<Ang≤270时,减掉180
  78.               (atan (/ (/ (sin Ang) (cos Ang)) Ratio))
  79.           )
  80.       )
  81.   )
  82.   (setq  BoundLst nil) ;生成的边界线图元表
  83.   (if (and
  84.         (setq ent (entget En))
  85.         (= "HATCH" (K:GetEnDXF 0 ent))
  86.       )
  87.       (progn
  88.         (setq HLay (if OriLay  (K:GetEnDXF 8 ent)(getvar "CLAYER"));填充图层
  89.               PathNum (K:GetEnDXF 91 ent);路径环数
  90.               PathBD1 Nil
  91.               PathBD2 Nil
  92.         )
  93.         (repeat PathNum
  94.             (setq ent (member (assoc 92 ent) ent))
  95.             (setq PathTyp (cdr (car ent)));路径环类型
  96.             (setq VtxNum (K:GetEnDXF 93 ent));当路径环为多段线时表示顶点数量,否则表示边的数量
  97.             (if (> (boole 1 PathTyp 2) 0);路径环是多段线
  98.               (progn
  99.                 (setq ent (member (assoc 72 ent) ent))
  100.                 (setq HasBlg (cdr (car ent)));当路径环为多段线时表示凸度标志,否则表示边类型

  101.                 (setq PtLst nil)
  102.                 (setq IsClsd (K:GetEnDXF 73 ent));当路径环为多段线时表示闭合标志
  103.                 (repeat VtxNum
  104.                     (setq ent (member (assoc 10 (cdr ent)) ent))
  105.                     (setq PtLst (cons (assoc 10 ent) PtLst))
  106.                     (if (> HasBlg 0) ;有凸度
  107.                       (setq PtLst (cons (assoc 42 ent) PtLst))
  108.                     )
  109.                 )
  110.                 (setq TgtEn
  111.                     (entmakeX
  112.                         (append
  113.                             (list
  114.                                 '(0 . "LWPOLYLINE")
  115.                                 '(100 . "AcDbEntity")
  116.                                 '(100 . "AcDbPolyline")
  117.                                 (cons 8 HLay);填充图层
  118.                                 (cons 90 VtxNum)
  119.                                 (cons 70 IsClsd)
  120.                             )
  121.                             (reverse PtLst)
  122.                         )
  123.                     )
  124.                 )
  125.                 (setq PathBD1 (cons TgtEn PathBD1));收集边界图元
  126.               )
  127.               (progn
  128.                 (progn
  129.                   (setq Cvt2PLst NIL)
  130.                   (repeat VtxNum
  131.                     (setq ent (member (assoc 72 ent) ent));回到边起点
  132.                     (setq EdgTyp (K:GetEnDXF 72 ent));边类型
  133.                     (cond
  134.                       ((eq EdgTyp 1);直线
  135.                           (setq ent (cdr ent));跳到下一段
  136.                           (setq DATA
  137.                                 (list
  138.                                   (cons 10 (K:GetEnDXF 10 ent))
  139.                                   (cons 42 0.0)
  140.                                   (cons 10 (K:GetEnDXF 11 ent))
  141.                                 )
  142.                           )
  143.                           (if (not (member DATA Cvt2PLst))
  144.                               (setq Cvt2PLst (cons DATA Cvt2PLst))
  145.                           );收集数据
  146.                       )
  147.                       ((eq EdgTyp 2);圆OR圆弧
  148.                           (setq ent (cdr ent));跳到下一段
  149.                           (setq StaAng (K:GetEnDXF 50 ent);起点角度
  150.                                 EndAng (K:GetEnDXF 51 ent);终点角度
  151.                                 ISCCLK (K:GetEnDXF 73 ent);逆时针标记
  152.                           )
  153.                           (if (equal (- EndAng StaAng) 6.28319 1.0e-005);起点终点差360度为圆
  154.                             (progn
  155.                               (setq TgtEn (entmakeX
  156.                                             (list
  157.                                               (cons 0 "CIRCLE")
  158.                                               (cons 8 HLay);填充图层
  159.                                               (assoc 10 ent)
  160.                                               (assoc 40 ent)
  161.                                             )
  162.                                           )
  163.                               )
  164.                               (setq PathBD2 (cons TgtEn PathBD2));收集边界图元
  165.                             )
  166.                             (progn
  167.                               (setq DATA
  168.                                   (if (eq ISCCLK 0)
  169.                                       (K:Arc->Bulge (K:GetEnDXF 10 ent) (K:GetEnDXF 40 ent) (- EndAng) (- StaAng))
  170.                                       (K:Arc->Bulge (K:GetEnDXF 10 ent) (K:GetEnDXF 40 ent) StaAng EndAng)
  171.                                   )
  172.                               )
  173.                               (if (not (member DATA Cvt2PLst))
  174.                                   (setq Cvt2PLst (cons DATA Cvt2PLst))
  175.                               );收集数据
  176.                             )
  177.                           )
  178.                           
  179.                       )
  180.                       ((eq EdgTyp 3);椭圆OR椭圆弧
  181.                         (setq ent (cdr ent));跳到下一段
  182.                         (setq StaAng (K:GetEnDXF 50 ent);起点角度
  183.                               EndAng (K:GetEnDXF 51 ent);终点角度
  184.                               ISCCLK (K:GetEnDXF 73 ent);逆时针标记
  185.                               ERatio (K:GetEnDXF 40 ent);短长轴比率
  186.                         )
  187.                         (if (equal (- EndAng StaAng) 6.28319 1.0e-005);起点终点差360度为圆
  188.                           (progn
  189.                             (setq TgtEn
  190.                                 (entmakeX
  191.                                     (list
  192.                                       '(0 . "ELLIPSE")
  193.                                       '(100 . "AcDbEntity")
  194.                                       '(100 . "AcDbEllipse")
  195.                                       (cons 8 HLay);填充图层
  196.                                       (assoc 10 ent)
  197.                                       (assoc 11 ent)
  198.                                       (assoc 40 ent)
  199.                                       (cons 8 HLay);填充图层
  200.                                       (cons 41 0.0)
  201.                                       (cons 42 (* 2 pi))
  202.                                     )
  203.                                 )
  204.                             )
  205.                             (setq PathBD2 (cons TgtEn PathBD2));收集边界图元
  206.                           )
  207.                           (progn
  208.                             (setq TgtEn
  209.                                 (entmakeX
  210.                                     (list
  211.                                       '(0 . "ELLIPSE")
  212.                                       '(100 . "AcDbEntity")
  213.                                       '(100 . "AcDbEllipse")
  214.                                       (cons 8 HLay);填充图层
  215.                                       (assoc 10 ent)
  216.                                       (assoc 11 ent)
  217.                                       (assoc 40 ent)
  218.                                       (cons 8 HLay);填充图层
  219.                                       (if (eq ISCCLK 0) ;逆时针
  220.                                         (progn
  221.                                           (cons 41 (K:ElAng->Par (- EndAng) ERatio))
  222.                                           (cons 42 (K:ElAng->Par (- StaAng) ERatio))
  223.                                         )
  224.                                         (progn
  225.                                           (cons 41 (K:ElAng->Par StaAng ERatio))
  226.                                           (cons 42 (K:ElAng->Par EndAng ERatio))
  227.                                         )
  228.                                       )
  229.                                     )
  230.                                 )
  231.                             )
  232.                             (setq PathBD2 (cons TgtEn PathBD2));收集边界图元
  233.                           )
  234.                         )
  235.                       )
  236.                       ((eq EdgTyp 4);样条曲线
  237.                           (setq ent (cdr ent));跳到下一段
  238.                           (progn
  239.                               (setq KnpNum (K:GetEnDXF 95 ent);节点数
  240.                                     CtrNum (K:GetEnDXF 96 ent);控制点数
  241.                               )

  242.                               (setq Front (list
  243.                                             '(0 . "SPLINE")
  244.                                             (cons 100 "AcDbEntity")
  245.                                             (cons 100 "AcDbSpline")
  246.                                             (cons 8 HLay);填充图层
  247.                                             (cons
  248.                                               70
  249.                                               (+
  250.                                                 (if (> VtxNum 1) 0 1)
  251.                                                 8
  252.                                                 (* 2 (K:GetEnDXF 73 ent));有理
  253.                                                 (* 4 (K:GetEnDXF 74 ent));周期
  254.                                               )
  255.                                             )
  256.                                             (cons 71 (K:GetEnDXF 94 ent));阶数
  257.                                             (cons 72 KnpNum);节点数
  258.                                             (cons 73 CtrNum);控制点数
  259.                                           )
  260.                               )
  261.                            
  262.                               (setq KnpLst nil CtrLst nil)
  263.                               (setq ent (member (assoc 40 ent) ent))
  264.                                 (repeat KnpNum
  265.                                   (setq KnpLst (cons (car ent) KnpLst))
  266.                                   (setq ent (cdr ent))
  267.                                 )
  268.                               (setq ent (member (assoc 10 ent) ent))
  269.                                 (repeat CtrNum
  270.                                   (setq CtrLst (cons (car ent) CtrLst))
  271.                                   (setq ent (cdr ent))
  272.                                 )
  273.                           )
  274.                           (setq TgtEn (entmakeX (append Front (reverse KnpLst) (reverse CtrLst))))
  275.                           (setq PathBD2 (cons TgtEn PathBD2));收集边界图元
  276.                       )
  277.                     )
  278.                   )
  279.                   (if Cvt2PLst
  280.                       (progn
  281.                         (setq Cvt2PLst (K:LineArc2PL (mapcar 'reverse Cvt2PLst)));首尾颠倒来一次
  282.                         (setq Cvt2PLst (K:LineArc2PL (mapcar 'reverse Cvt2PLst)));首尾颠倒再来一次
  283.                         (foreach XX Cvt2PLst
  284.                             (setq TgtEn
  285.                                   (entmakeX
  286.                                     (append
  287.                                       (list
  288.                                           '(0 . "LWPOLYLINE")
  289.                                           '(100 . "AcDbEntity")
  290.                                           '(100 . "AcDbPolyline")
  291.                                           (cons 8 HLay);填充图层
  292.                                           (cons 70 1)
  293.                                           (cons 90 (1+ (fix (* 0.5 (length XX)))))
  294.                                       )
  295.                                       XX
  296.                                     )
  297.                                   )
  298.                             )
  299.                             (setq PathBD2 (cons TgtEn PathBD2));收集边界图元
  300.                         )
  301.                       )
  302.                   )
  303.                 )
  304.               )
  305.             )
  306.         )
  307.         (setq BoundLst (append PathBD1 PathBD2));收集边界图元
  308.       )
  309.   )
  310.   BoundLst
  311. )

发表于 2024-2-23 00:42 | 显示全部楼层
谢谢大佬一直分享这么好用的代码
下载来试试看
发表于 2024-2-23 10:44 | 显示全部楼层
能做个动图吗谢谢,不会用
 楼主| 发表于 2024-2-23 11:02 | 显示全部楼层
wangsr 发表于 2024-2-23 10:44
能做个动图吗谢谢,不会用

跟命令HATCHGENERATEBOUNDARY差不多
发表于 2024-2-23 11:50 | 显示全部楼层
还有这么长的命令
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-5-18 12:04 , Processed in 0.270685 second(s), 32 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表