明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 5192|回复: 13

[源码] 【源码】带圆弧多段线优化分段转区域覆盖

[复制链接]
发表于 2018-1-1 17:11:16 | 显示全部楼层 |阅读模式
庆祝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")

;;主要有大量标准图块需要做遮挡,好累,编了一周时间,作为一个菜鸟不容易了,欢迎高手提出改进,有些代码是搬的累死偶了。为了方便检查变量都尽量设置成容易认读的名字;有很多地方啰嗦了是功力不够的原因,见谅


发表于 2018-9-28 13:41:04 | 显示全部楼层
大师能不能搞一个
提取图块外轮廓的程序啊
谢谢
发表于 2024-5-24 15:13:39 | 显示全部楼层
带圆弧的多段线不能用、没有圆弧的可以
发表于 2021-1-29 15:39:31 | 显示全部楼层
非常不错的代码, 谢谢楼主分享。
发表于 2018-1-1 23:34:33 | 显示全部楼层
新年快乐,感谢源码!学习学习
发表于 2018-1-4 11:31:45 | 显示全部楼层

感谢你的分享
发表于 2018-1-4 23:56:28 | 显示全部楼层
感谢分享程序!!!!
发表于 2018-1-5 09:46:54 | 显示全部楼层
来个演示呗
发表于 2018-1-6 17:53:01 | 显示全部楼层
不知用途-------
发表于 2018-2-14 21:14:39 | 显示全部楼层
谢谢分享,春节快乐!
发表于 2018-2-28 11:14:49 | 显示全部楼层


感谢你的分享
发表于 2018-3-1 09:36:50 | 显示全部楼层
请楼主来个演示,看着方便
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-11-25 17:21 , Processed in 0.206280 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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