【源码】带圆弧多段线优化分段转区域覆盖
庆祝2018，充满希望的一年;用途：可以接续【YAD建筑】图块获取轮廓函数自动生成遮盖
;选择2次，输入2次；可优化为选择一次输入0次
;后续优化：将生成的区域遮盖置入图块
(vl-load-com)
(defun c:pl2w (/ ss ent_pline ent_mark)
(setvar "cmdecho" 0);取消屏幕回显
(setvar "osmode" 0);设置捕捉
(setq ent_pline (ssget":s" '((0 . "LWPOLYLINE"))));选择一条多段线
(vl-cmdf "_copy" ent_pline "" "d" "");复制一个出来作为entlast标记
(setq ent_mark (entlast));将复制出来的多段线作为标记
(setq ent_del ent_mark);赋值清理图元
(princ ent_del);检查图元赋值
(vl-cmdf "_.explode" ent_pline );炸开多段线
(user:divideARC);等分圆弧算法【待优化选择过滤，自动运行:方法1：可获取多段线的外包盒，用带窗口的过滤选择】
(user:selectaftermark);获取新生成的所有图元
(user:pline_jion ent_aftermark);将所有线元join to one
(vl-cmdf "_.erase" ent_del "");删除标记图元
(setq LWPOLYLINE_converted (entlast));赋值被转化多段线
(setq Lname "IFF-wipeout");输入转换后的区域覆盖放置在哪个图层
(user:convert_WIPEOUT LWPOLYLINE_converted Lname);转换函数可字型修改到自己的图层设置
(setvar "osmode" 111)
(princ)
)
;;;■0.函数：返回自实体E之后生成的实体选择集
(defun user:selectaftermark (/ ent_number)
(setq ent_aftermark (ssadd))
(while (setq ent_mark (entnext ent_mark))
(ssadd ent_mark ent_aftermark)
)
(setq ent_number (sslength ent_aftermark))
);END_定义函数
;;;■0.函数：拍平表。作者:狂刀
(defun flatten (lst / a)
(cond ((null lst) nil)
((atom lst) (list lst))
(T (setq a (flatten (car lst)))(append (if a a '(nil))(flatten (cdr lst))))
));end_defun
;;;■0.函数：曲线长度
(defun curvelength (ent)
(setq obj (vlax-ename->vla-object ent))
(setq curve_length (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)))
curve_length
);ok
;打印语句方便加载时检查出错的位置
(princ "\n函数0")
;;;■1.函数：将指定线对象EN按照指定数目N等分打断。作者:zml84
(defun break-curve (EN N / OBJ LEN LENI PT PT_LST)
(and ;;判断参数有效性
(> N 1)
;;转换对象名类型
(setq OBJ (vlax-ename->vla-object EN))
;;获取对象总长度
(setq LEN (vlax-curve-getdistatpoint
OBJ
(vlax-curve-getendpoint OBJ)
)
)
;;计算等分点位
(setq PT_LST '() ;_存放等分点位的表
LENI (/ LEN 1.0 N)
LEN 0
)
(repeat (1- N)
(setq LEN (+ LEN LENI)
PT (vlax-curve-getpointatdist OBJ LEN)
PT_LST (cons PT PT_LST)
)
)
;;进行等分操作
(foreach PT PT_LST
(command "_.break" (list EN PT) "f" "non" PT "non" PT)
)
)
)
(princ "\n函数1")
;;;■2.函数：等分圆弧
(defun user:divideARC (/ arc_ents arc_ent segment_N segment_TN I segment_length length_list sum_length relay_data)
(princ "\n选择要等分打断的线元...")
;;;■0.根据多段线的最大外框扩大后用w模式选取(ssget"w" pt1 pt2 '((0 . "ARC")))),这两个点坐标需从主处理函数继承
(if (setq arc_ents(ssget '((0 . "ARC"))))
(progn
(user:count_length_i arc_ents)
;;;■以下打印语句为调试时检查函数输出状况正式程序取消
(princ "\n 总长")
(princ sum_length)
(princ "\n 查表")
(princ length_list)
(setq segment_low(* 2 (sslength arc_ents)));确保每段弧最少有一个细分点
(setq I 0)
(if (>= segment_low (setq segment_TN(getint "\n输入总分段数:")));;;■0.总分段数可以与多段线总长度相关
(setq segment_TN segment_low)
);end_if
(setq segment_length(/ sum_length segment_TN))
(repeat (sslength arc_ents)
(setq arc_ent(ssname arc_ents I))
;;;■1.每段曲线上不论长短最少添加一个中点
;;;■2.限定总节点数pn
;;;■3.按所有曲线n段总弧长与pline线长的比值分配节点数，先计算全部弧线的长度,再除以pn-2n,用本段弧长除以段长取整且大于等于2分别得出隔断圆弧的等分数
;;;■4.每段曲线的分段数其实应该用双控，弧度长度比值法确定;现在实例用的是最短线段控制
(setq relay_data (fix (+ 0.5 (/ (nth i length_list) segment_length))));本段长度与预估分断长度比值确定本段分段数
;;;■以下打印语句为调试时使用可取消
(princ "\n 测试分段数打印结果")
(princ "\n 第") (princ i) (princ "次分断结果：【 ")
(princ relay_data)
(princ " 】")
(if (>= 2 (/ (nth i length_list) segment_length))
(setq segment_N 2)
(setq segment_N relay_data)
);end_if
(break-curve arc_ent segment_N) ;_调用函数，打断操作可以是线多义线圆弧等
(setq I (1+ I))
);end_repeat
);end_progn
(princ "\n未选择任何任何弧线")
);end_if
(princ)
)
(princ "\n函数2")
;;;■3.函数：连接多段线
(defun user:pline_jion (ss / pline_dist)
(setvar "PEDITACCEPT" 1);抑制在使用PEDIT时，显示"选取的对象不是多段线"的提示
(princ "\n输入容差<")(princ save_pline_dist)(princ">")
(setq pline_dist(getdist))
;;;对容差进行赋值;这一段感觉罗嗦了见谅,希望高手简化；喜欢干脆的可以直接
(if (= pline_dist nil)
(if (= save_pline_dist nil)
(progn
(alert "请输入容差!!!")
(setq pline_dist(getreal))
(setq save_pline_dist pline_dist)
)
(setq pline_dist save_pline_dist);提取默认容差
)
)
(vl-cmdf "pedit" "m" ss "" "j" pline_dist "");连接很奇怪不能在一个命令里完成下面非曲线化和封闭
(vl-cmdf "pedit" "L" "d" “c” "");非曲线化及封闭
(setq save_pline_dist pline_dist);存储默认容差
(setvar "PEDITACCEPT" 0)
(princ)
)
(princ "\n函数3")
;;;■4.函数：多段线转区域覆盖
(defun user:convert_WIPEOUT (ent_converted Lname)
(if (not (tblsearch "layer" Lname))
(vl-cmdf "layer" "m" Lname "l""DOT2""" "c""135""" "")
);end if
(vl-cmdf "layer" "s" Lname "l""DOT2" Lname "c""135" Lname "")
(vl-cmdf "chprop" ent_converted "" "p" "la" Lname "c" "bylayer" "")
(vl-cmdf "wipeout" "p" ent_converted "y" ) (prin1);删除多义线
(vl-cmdf "draworder" "L" "" "b");后置
; (vl-cmdf "draworder" "l" "" "f");前置
)
(princ "\n函数4")
;;;■5.函数：计算选择曲线总长度
(defun user:count_length_i (selcet_ents / ent_ARCi ent_length n)
(setq sum_length 0)
(setq n 0)
(setq length_list '());建立空表
(while (< n (sslength selcet_ents))
(setq ent_ARCi(ssname selcet_ents n))
(setq ent_length(curvelength ent_ARCi))
(setq n (1+ n))
(if (= nil length_list)
(setq length_list(list ent_length))
;(setq length_list (list ent_length n))
(setq length_list(list length_list (list ent_length)))
);end_if_ok
(setq length_list(flatten length_list))
(setq sum_length (+ sum_length ent_length))
)
length_list
sum_length
)
(princ "\n函数5")
;;主要有大量标准图块需要做遮挡，好累，编了一周时间，作为一个菜鸟不容易了，欢迎高手提出改进，有些代码是搬的累死偶了。为了方便检查变量都尽量设置成容易认读的名字；有很多地方啰嗦了是功力不够的原因，见谅
大师能不能搞一个
提取图块外轮廓的程序啊
谢谢 带圆弧的多段线不能用、没有圆弧的可以 非常不错的代码， 谢谢楼主分享。 新年快乐，感谢源码！学习学习
感谢你的分享 感谢分享程序!!!! 来个演示呗 不知用途------- 谢谢分享，春节快乐！
感谢你的分享 请楼主来个演示，看着方便 谢谢分享
页:
[1]
2