【K:Hatch2BD】生成填充边界并返回图元表
本帖最后由 kucha007 于 2024-2-24 15:03 编辑此函数修改自论坛，最早好像是飞诗写的，后来小菜也有修改。功能类似CAD自带的HATCHGENERATEBOUNDARY
程序我也做了点调整，本来是为了版本通用，不打算使用VL函数，但排序还是跑不了......
所以看起来只是椭圆用了entmakeX生成，变量改名，增加椭圆是否完整的判断，加了一些注释。
目前直线弧线合并数据再生成多段线不是很完美，还在摸索。
填充重新关联边界：此函数是利用了重新生成+格式刷，容易出错。还想试试97和330，但目前测试未通过。
总之欢迎大家一起来玩~
函数说明：
(K:Hatch2BD 填充选择集 填充层(OR当前层)？ 重生成填充使其关联边界？)
返回：
(list 边界线选择集 边界线图元表)
参考用法一：
(if (setq SSH (ssget '((0 . "HATCH"))))
(princ (K:Hatch2BD SSH Nil Nil))
)参考用法二：
(if (setq SSH (ssget '((0 . "HATCH"))))
(command "_.ERASE"(car (K:Hatch2BD SSH Nil Nil)) pause "" )
)
参考资料备份一下，有时间再看看：
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
本帖最后由 kucha007 于 2024-3-24 23:02 编辑
做了个针对实体的子函数：关联重做用处不大删除了，有兴趣的小伙伴自行添加
;生成填充实体的并返回图元表@Kucha：(K:GetHatchBD 填充实体 边界层(在填充层？))
(defun K:GetHatchBD (En OriLay
/ K:GetEnDXF K:Arc->Bulge K:LineArc2PL K:ElAng->Par
BoundLst ent HLay PathNum PathBD1 PathBD2
PathTyp EdgTyp Cvt2PLst DATA VtxNum HasBlg PtLst IsClsd TgtEn
StaAng EndAng ISCCLK ERatio
KnpNum CtrNum Front KnpLst CtrLst
)
(progn ;基础函数
;获取实体DXF组码值
(defun K:GetEnDXF (key en) (cdr (assoc key en)))
;圆弧数据转多段线数据@LEEMAC
(defun K:Arc->Bulge (Cen Rad StaAng EndAng )
(mapcar 'cons '(10 42 10)
(list
(polar Cen StaAng Rad)
((lambda (a) (/ (sin a) (cos a)))
(/ (rem (+ pi pi (- EndAng StaAng)) (+ pi pi)) 4.0)
)
(polar Cen EndAng Rad)
)
)
)
;直线和圆弧转多段线数据处理@Kucha
(defun K:LineArc2PL (OldLst / Fun NewLst Tmp BseLst BseVar Pos item)
;|
(setq OldLst
(list
(list
(list 10 -1474.19 -1780.16 0.0)
(list 42 0.0)
(list 10 -1423.16 -1780.16 0.0)
)
(list
(list 10 -1423.16 -1780.16 0.0)
(list 42 0.0)
(list 10 -1423.16 -1729.13 0.0)
)
(list
(list 10 -1474.19 -1729.13 0.0)
(list 42 0.0)
(list 10 -1474.19 -1780.16 0.0)
)
(list
(list 10 -1423.16 -1729.13 0.0)
(list 42 0.0)
(list 10 -1474.19 -1729.13 0.0)
)
)
)
|;
(setq OldLst (vl-sort OldLst '(lambda (a b) (< (cadr (car a)) (cadr (last b))))))
(setq Fun (lambda (a b)
(if (equal (Last a) (caar b) 0.01);第一项的最后等于第二项的第一
(progn
(setq Tmp (append Tmp (cdar b)))
(Fun Tmp (cdr b))
)
(list b Tmp)
)
)
)
(if OldLst
(cons
(append
(car OldLst)
(cadr (setq NewLst (Fun (car OldLst) (cdr OldLst))))
)
(K:LineArc2PL (car NewLst))
)
)
)
;椭圆真实角度转参数@edata
(defun K:ElAng->Par (Ang Ratio)
;(K:ElAng->Par 真实弧度 短长轴比率)
(if (and (> Ang (* pi 0.5)) (<= Ang (* pi 1.5)))
(- (atan (/ (/ (sin Ang) (cos Ang)) Ratio)) pi);当角度值90<Ang≤270时，减掉180
(atan (/ (/ (sin Ang) (cos Ang)) Ratio))
)
)
)
(setqBoundLst nil) ;生成的边界线图元表
(if (and
(setq ent (entget En))
(= "HATCH" (K:GetEnDXF 0 ent))
)
(progn
(setq HLay (if OriLay(K:GetEnDXF 8 ent)(getvar "CLAYER"));填充图层
PathNum (K:GetEnDXF 91 ent);路径环数
PathBD1 Nil
PathBD2 Nil
)
(repeat PathNum
(setq ent (member (assoc 92 ent) ent))
(setq PathTyp (cdr (car ent)));路径环类型
(setq VtxNum (K:GetEnDXF 93 ent));当路径环为多段线时表示顶点数量，否则表示边的数量
(if (> (boole 1 PathTyp 2) 0);路径环是多段线
(progn
(setq ent (member (assoc 72 ent) ent))
(setq HasBlg (cdr (car ent)));当路径环为多段线时表示凸度标志，否则表示边类型
(setq PtLst nil)
(setq IsClsd (K:GetEnDXF 73 ent));当路径环为多段线时表示闭合标志
(repeat VtxNum
(setq ent (member (assoc 10 (cdr ent)) ent))
(setq PtLst (cons (assoc 10 ent) PtLst))
(if (> HasBlg 0) ;有凸度
(setq PtLst (cons (assoc 42 ent) PtLst))
)
)
(setq TgtEn
(entmakeX
(append
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 8 HLay);填充图层
(cons 90 VtxNum)
(cons 70 IsClsd)
)
(reverse PtLst)
)
)
)
(setq PathBD1 (cons TgtEn PathBD1));收集边界图元
)
(progn
(progn
(setq Cvt2PLst NIL)
(repeat VtxNum
(setq ent (member (assoc 72 ent) ent));回到边起点
(setq EdgTyp (K:GetEnDXF 72 ent));边类型
(cond
((eq EdgTyp 1);直线
(setq ent (cdr ent));跳到下一段
(setq DATA
(list
(cons 10 (K:GetEnDXF 10 ent))
(cons 42 0.0)
(cons 10 (K:GetEnDXF 11 ent))
)
)
(if (not (member DATA Cvt2PLst))
(setq Cvt2PLst (cons DATA Cvt2PLst))
);收集数据
)
((eq EdgTyp 2);圆OR圆弧
(setq ent (cdr ent));跳到下一段
(setq StaAng (K:GetEnDXF 50 ent);起点角度
EndAng (K:GetEnDXF 51 ent);终点角度
ISCCLK (K:GetEnDXF 73 ent);逆时针标记
)
(if (equal (- EndAng StaAng) 6.28319 1.0e-005);起点终点差360度为圆
(progn
(setq TgtEn (entmakeX
(list
(cons 0 "CIRCLE")
(cons 8 HLay);填充图层
(assoc 10 ent)
(assoc 40 ent)
)
)
)
(setq PathBD2 (cons TgtEn PathBD2));收集边界图元
)
(progn
(setq DATA
(if (eq ISCCLK 0)
(K:Arc->Bulge (K:GetEnDXF 10 ent) (K:GetEnDXF 40 ent) (- EndAng) (- StaAng))
(K:Arc->Bulge (K:GetEnDXF 10 ent) (K:GetEnDXF 40 ent) StaAng EndAng)
)
)
(if (not (member DATA Cvt2PLst))
(setq Cvt2PLst (cons DATA Cvt2PLst))
);收集数据
)
)
)
((eq EdgTyp 3);椭圆OR椭圆弧
(setq ent (cdr ent));跳到下一段
(setq StaAng (K:GetEnDXF 50 ent);起点角度
EndAng (K:GetEnDXF 51 ent);终点角度
ISCCLK (K:GetEnDXF 73 ent);逆时针标记
ERatio (K:GetEnDXF 40 ent);短长轴比率
)
(if (equal (- EndAng StaAng) 6.28319 1.0e-005);起点终点差360度为圆
(progn
(setq TgtEn
(entmakeX
(list
'(0 . "ELLIPSE")
'(100 . "AcDbEntity")
'(100 . "AcDbEllipse")
(cons 8 HLay);填充图层
(assoc 10 ent)
(assoc 11 ent)
(assoc 40 ent)
(cons 8 HLay);填充图层
(cons 41 0.0)
(cons 42 (* 2 pi))
)
)
)
(setq PathBD2 (cons TgtEn PathBD2));收集边界图元
)
(progn
(setq TgtEn
(entmakeX
(list
'(0 . "ELLIPSE")
'(100 . "AcDbEntity")
'(100 . "AcDbEllipse")
(cons 8 HLay);填充图层
(assoc 10 ent)
(assoc 11 ent)
(assoc 40 ent)
(cons 8 HLay);填充图层
(if (eq ISCCLK 0) ;逆时针
(progn
(cons 41 (K:ElAng->Par (- EndAng) ERatio))
(cons 42 (K:ElAng->Par (- StaAng) ERatio))
)
(progn
(cons 41 (K:ElAng->Par StaAng ERatio))
(cons 42 (K:ElAng->Par EndAng ERatio))
)
)
)
)
)
(setq PathBD2 (cons TgtEn PathBD2));收集边界图元
)
)
)
((eq EdgTyp 4);样条曲线
(setq ent (cdr ent));跳到下一段
(progn
(setq KnpNum (K:GetEnDXF 95 ent);节点数
CtrNum (K:GetEnDXF 96 ent);控制点数
)
(setq Front (list
'(0 . "SPLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbSpline")
(cons 8 HLay);填充图层
(cons
70
(+
(if (> VtxNum 1) 0 1)
8
(* 2 (K:GetEnDXF 73 ent));有理
(* 4 (K:GetEnDXF 74 ent));周期
)
)
(cons 71 (K:GetEnDXF 94 ent));阶数
(cons 72 KnpNum);节点数
(cons 73 CtrNum);控制点数
)
)
(setq KnpLst nil CtrLst nil)
(setq ent (member (assoc 40 ent) ent))
(repeat KnpNum
(setq KnpLst (cons (car ent) KnpLst))
(setq ent (cdr ent))
)
(setq ent (member (assoc 10 ent) ent))
(repeat CtrNum
(setq CtrLst (cons (car ent) CtrLst))
(setq ent (cdr ent))
)
)
(setq TgtEn (entmakeX (append Front (reverse KnpLst) (reverse CtrLst))))
(setq PathBD2 (cons TgtEn PathBD2));收集边界图元
)
)
)
(if Cvt2PLst
(progn
(setq Cvt2PLst (K:LineArc2PL (mapcar 'reverse Cvt2PLst)));首尾颠倒来一次
(setq Cvt2PLst (K:LineArc2PL (mapcar 'reverse Cvt2PLst)));首尾颠倒再来一次
(foreach XX Cvt2PLst
(setq TgtEn
(entmakeX
(append
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 8 HLay);填充图层
(cons 70 1)
(cons 90 (1+ (fix (* 0.5 (length XX)))))
)
XX
)
)
)
(setq PathBD2 (cons TgtEn PathBD2));收集边界图元
)
)
)
)
)
)
)
(setq BoundLst (append PathBD1 PathBD2));收集边界图元
)
)
BoundLst
)
谢谢大佬一直分享这么好用的代码
下载来试试看 能做个动图吗谢谢，不会用 wangsr 发表于 2024-2-23 10:44
能做个动图吗谢谢，不会用
跟命令HATCHGENERATEBOUNDARY差不多 还有这么长的命令 {:1_1:}{:1_1:}{:1_1:}{:1_1:}{:1_1:}{:1_1:}{:1_1:}
页:
[1]