设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › 道路设计横断面挖台阶
返回列表 发新帖
查看: 1172|回复: 3

[每日一码] 道路设计横断面挖台阶

[复制链接]
fengyun7000

已领礼包: 55个

财富等级: 招财进宝
发表于 2018-12-6 10:49:29 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要 登录 才可以下载或查看，没有账号？立即注册

×
本帖最后由 newer 于 2018-12-6 11:06 编辑

  1. ;;;本程序用于横断面台阶设计,准备横断面如实例，运行TAIJIE
  2. ;;;首先在CAD中选择要画横断面的线，LINE PLINE均可，次序不影响
  3. ;;;然后输入台阶宽度，坡率即可
  4. ;;;套用大师的排序程序，恕不缴费
  5. ;;;设计者：韩建文，尚不完善，发个玩玩！！！
  6. (defun C:taijie()
  7.         (setq tl (getdist"/n 请输入台阶水平宽度："))
  8.         (setq tp (getdist"/n 请输入台阶水平坡率："))
  9.         ;取得系统默认扑捉模式
  10.         (setq os(getvar"OSMODE"))
  11.         ;设定程序使用捕捉模式，全捕捉
  12.         (setvar"OSMODE" 4133)
  13.         (setq pt0 (getpoint"/n 请输入台阶起点："))
  14.         (setq ptz (getpoint"/n 请输入台阶终点："))
  15.         ;获得选择集
  16.         (setq ts (ssget))
  17.         ;取消光标捕捉
  18.         (setvar"OSMODE" 0)
  19.         ;设定图层和台阶线颜色
  20.         (if(null (tblsearch"layer""taijie"))
  21.                     (command"layer""new""taijie""color""yellow""taijie""lt""continuous""taijie""lw""0.2""taijie""")
  22.         )
  23.          (setvar"CLAYER""taijie")

  25.         ;如果是直线段，操作选择集排序，按10位x坐标从小到大排序
  26.         (vl-load-com)
  27.         (setq ts(SORT-SE ts 10 0 nil nil))        

  29.         ;如果是直线段组成，操作选择集，去除画台阶范围之外的线段
  30.         (setq n 0)
  31.         (repeat (sslength ts)

  33.                 (setq e (ssname ts n))
  34.                 (setq el (entget e))
  35.                 (setq n (+ n 1))
  36.                 (if (= "LINE" (cdr(assoc 0 el)))
  37.                 (progn
  38.                         (setq p1 (cdr(assoc 10 el)))
  39.                         (setq p2 (cdr(assoc 11 el)))
  40.                         (if (and (<= (car p1) (car pt0)) (<= (car p2) (car pt0)))
  41.                         (progn
  42.                                 (setq ts (ssdel e ts))
  43.                                 (setq n(- n 1))
  44.                         );eng progn
  45.                         );endif
  46.                         (if (and (>= (car p1) (car ptz)) (>= (car p2) (car ptz)))
  47.                         (progn
  48.                                 (setq ts (ssdel e ts))
  49.                                 (setq n(- n 1))
  50.                         );eng progn
  51.                         );endif
  52.                 );end progn
  53.                 );endif

  55.          );end repeat

  57.         ;选择集从第一个开始
  58.         (setq n 0)
  59.         (repeat (sslength ts)

  61.                 (setq e (ssname ts n))
  62.                 (setq el (entget e))
  63.                 ;如果是直线LINE
  64.                 (if (= "LINE" (cdr(assoc 0 el)))
  65.                 (progn
  66.                 (setq p1 (cdr(assoc 10 el)))
  67.                 (setq p2 (cdr(assoc 11 el)))
  68.                 ;如果线段P2交点在划线端点之外，则调整端点为P2点
  69.                 (if (<(car ptz) (car p2)) (setq p2 ptz))
  70.                 (while (< (car pt0) (car p2))
  71.                         (setq ang1 (angle p1 p2))
  72.                         (setq tll tl)
  73.                         (if (> ang1 (* 1.5 pi))
  74.                                 (progn
  75.                                 (setq th (* tll tp))
  76.                                 (setq pt1 (list (car pt0) (+ (cadr pt0) (* tll (/ (sin ang1) (cos ang1))) th) 0.0))
  77.                                 (setq pt2 (list (+ (car pt0) tll) (+ (cadr pt0) (* tll (/ (sin ang1) (cos ang1)))) 0.0))
  78.                                 (if(< (- (car p2) (car pt2)) tll)
  79.                                         (progn
  80.                                         (setq tll (+ (- (car p2) (car pt2)) tll))
  81.                                         (setq th (* tll tp))
  82.                                         (setq pt1 (list (car pt0) (+ (cadr pt0) (* tll (/ (sin ang1) (cos ang1))) th) 0.0))
  83.                                         (setq pt2 (list (+ (car pt0) tll) (+ (cadr pt0) (* tll (/ (sin ang1) (cos ang1)))) 0.0))
  84.                                         )
  85.                                 );endif
  86.                                 );end progn
  87.                         );endif
  88.                         (if (< ang1 (* 0.5 pi))
  89.                                 (progn
  90.                                 (setq th (* tll tp))
  91.                                 (setq pt1 (list (+ (car pt0) tll) (+ (cadr pt0) th) 0.0))
  92.                                 (setq pt2 (list (+ (car pt0) tll) (+ (cadr pt0) (* tll (/ (sin ang1) (cos ang1)))) 0.0))
  93.                                 (if(< (- (car p2) (car pt2)) tll)
  94.                                         (progn
  95.                                         (setq tll (+ (- (car p2) (car pt2)) tll))
  96.                                         (setq th (* tll tp))
  97.                                         (setq pt1 (list (+ (car pt0) tll) (+ (cadr pt0) th) 0.0))
  98.                                         (setq pt2 (list (+ (car pt0) tll) (+ (cadr pt0) (* tll (/ (sin ang1) (cos ang1)))) 0.0))
  99.                                         )
  100.                                 );endif
  101.                                 );end progn
  102.                         );endif
  103.                         (if(and (>= ang1 0.2) (<= ang1 6.08)) (command "line" pt0 pt1 pt2 ""))
  104.                         (setq pt0 pt2)
  105.                 );endwhile
  106.                 );end progn
  107.                 (setq n (+ n 1))
  108.                 )endif

  110.                 ;如果是多义线POLYLINE
  111.                 (if (= "LWPOLYLINE" (cdr(assoc 0 el)))
  112.                 ;获取多义线的顶点，首先取得起点坐标
  113.                 (PROGN
  114.                 (setq EN1_DATA el)
  115.                 (SETQ ZM1 0)
  116.                 (SETQ ZM (CDR (ASSOC 90 EN1_DATA)));顶点的数量
  117.                 ;循环直到第一个顶点
  118.                 (while (/= (CAR (CAR EN1_DATA)) 10)
  119.                         (SETQ EN1_DATA (CDR EN1_DATA))
  120.                 );endwhile
  121.                 ;找到第一个顶点，赋值P1
  122.                 (IF (= (CAR (CAR EN1_DATA)) 10)
  123.                         (PROGN
  124.                          (SETQ p1 (CDR (CAR EN1_DATA)));取出第一个点的坐标
  125.                           (SETQ ZM1 (+ ZM1 1))
  126.                         (setq EN1_DATA (CDR EN1_DATA))
  127.                         );end progn
  128.                 );END IF
  129.                 ;循环找到下一个顶点
  130.                    (WHILE (< ZM1 ZM)
  131.                 (while (/= (CAR (CAR EN1_DATA)) 10)
  132.                         (SETQ EN1_DATA (CDR EN1_DATA))
  133.                 );end while
  134.                 ;如果找到这个顶点，赋值P2
  135.                 (IF (= (CAR (CAR EN1_DATA)) 10)
  136.                         (PROGN
  137.                          (SETQ p2 (CDR (CAR EN1_DATA)));取出后续每一个点的坐标
  138.                           (SETQ ZM1 (+ ZM1 1))
  139.                         (setq EN1_DATA (CDR EN1_DATA))
  140.                         );END PROGN
  141.                  );END IF
  142.                         ;如果找到P1P2点在选择点之外，下一个实体
  143.                         (if (and (<(car p1) (car pt0)) (<(car p2) (car pt0))) (setq n (1+ n)))
  144.                         (if (and (>(car p1) (car ptz)) (>(car p2) (car pt0))) (setq n (1+ n)))
  145.                         ;开始画台阶
  146.                         (if (<(car ptz) (car p2)) (setq p2 ptz))
  147.                         (while (< (car pt0) (car p2))
  148.                         (setq ang1 (angle p1 p2))
  149.                         (setq tll tl)
  150.                         (if (> ang1 (* 1.5 pi))
  151.                                 (progn
  152.                                 (setq th (* tll tp))
  153.                                 (setq pt1 (list (car pt0) (+ (cadr pt0) (* tll (/ (sin ang1) (cos ang1))) th) 0.0))
  154.                                 (setq pt2 (list (+ (car pt0) tll) (+ (cadr pt0) (* tll (/ (sin ang1) (cos ang1)))) 0.0))
  155.                                 (if(< (- (car p2) (car pt2)) tll)
  156.                                         (progn
  157.                                         (setq tll (+ (- (car p2) (car pt2)) tll))
  158.                                         (setq th (* tll tp))
  159.                                         (setq pt1 (list (car pt0) (+ (cadr pt0) (* tll (/ (sin ang1) (cos ang1))) th) 0.0))
  160.                                         (setq pt2 (list (+ (car pt0) tll) (+ (cadr pt0) (* tll (/ (sin ang1) (cos ang1)))) 0.0))
  161.                                         )
  162.                                 );endif
  163.                                 );end progn
  164.                         );endif
  165.                         (if (< ang1 (* 0.5 pi))
  166.                                 (progn
  167.                                 (setq th (* tll tp))
  168.                                 (setq pt1 (list (+ (car pt0) tll) (+ (cadr pt0) th) 0.0))
  169.                                 (setq pt2 (list (+ (car pt0) tll) (+ (cadr pt0) (* tll (/ (sin ang1) (cos ang1)))) 0.0))
  170.                                 (if(< (- (car p2) (car pt2)) tll)
  171.                                         (progn
  172.                                         (setq tll (+ (- (car p2) (car pt2)) tll))
  173.                                         (setq th (* tll tp))
  174.                                         (setq pt1 (list (+ (car pt0) tll) (+ (cadr pt0) th) 0.0))
  175.                                         (setq pt2 (list (+ (car pt0) tll) (+ (cadr pt0) (* tll (/ (sin ang1) (cos ang1)))) 0.0))
  176.                                         )
  177.                                 );endif
  178.                                 );end progn
  179.                         );endif
  180.                         (if(and (>= ang1 0.2) (<= ang1 6.08)) (command "line" pt0 pt1 pt2 ""))
  181.                         (setq pt0 pt2)
  182.                         );endwhile
  183.                 (SETQ P1 P2)

  185.                 );END WHILE

  187.                 );end progn
  188.                 (setq n (1+ n))
  189.                 );end if
  190.         );endrepeat
  191.         (SETVAR "OSMODE" OS)
  192. )end defun

  194. ;;; 通用函数 选择集按照给定的组码值进行排序
  195. ;;;
  196. ;|;;参数说明：SE  ----要排序的选择集                                                                  
  197.               DXF ----排序依据的组码号                                                                 
  198.               INT ----如果组码值为一个表，则INT指出使用第几个；否则nil                                 
  199.               FUZZ----允许偏差；若无为nil                                                              
  200.               K   ----T表示从大到小，nil表示从小到大                                                   
  201.     返回值：排序后的选择集                                                                             
  202.     示例：(SORT-SE SS 10 0   5.0 T  )  表示按照10组码的X坐标值进行排序，允许偏差值为5.0，顺序为从大到小
  203.           (SORT-SE SS 10 1   3.0 NIL)  表示按照10组码的Y坐标值进行排序，允许偏差值为3.0，顺序为从小到大
  204.           (SORT-SE SS 8  NIL NIL NIL)  表示按照8组码值（图层名称）进行排序，顺序为从小到大            
  205. |;

  207. (defun SORT-SE (SE DXF INT FUZZ K / ENT INDEX LST NEWLST NEWSE TMP)
  208.     ;;建立排序列表
  209.     (setq LST '()
  210.           INDEX        0
  211.     )
  212.     (repeat (sslength SE)
  213.         (setq ENT (entget (ssname SE INDEX))
  214.               TMP (cdr (assoc DXF ENT))
  215.         )
  216.         (if (and INT
  217.                  (= (type INT) 'INT)
  218.                  (= (type TMP) 'list)
  219.                  (< INT (length TMP))
  220.             )
  221.             (setq TMP (nth INT TMP))
  222.         )
  223.         (setq LST (cons
  224.                       (list TMP (cdr (assoc 5 ENT)))
  225.                       LST
  226.                   )
  227.         )
  228.         (setq INDEX (1+ INDEX))
  229.     )
  230.     ;;排序操作
  231.     (if        (and FUZZ
  232.              (or
  233.                  (= (type FUZZ) 'INT)
  234.                  (= (type FUZZ) 'REAL)
  235.              )
  236.              (or
  237.                  (= (type TMP) 'INT)
  238.                  (= (type TMP) 'REAL)
  239.              )
  240.         )
  241.         (setq NEWLST
  242.                  (vl-sort LST
  243.                           (function (lambda (E1 E2)
  244.                                         (< (+ (car E1) FUZZ) (car E2))
  245.                                     )
  246.                           )
  247.                  )
  248.         )
  249.         (setq NEWLST
  250.                  (vl-sort LST
  251.                           (function (lambda (E1 E2)
  252.                                         (< (car E1) (car E2))
  253.                                     )
  254.                           )
  255.                  )
  256.         )
  257.     )
  258.     ;;如果K为T，则倒置
  259.     (if        K
  260.         (setq NEWLST (reverse NEWLST))
  261.     )
  262.     ;;组织排序后的选择集
  263.     (setq NEWSE (ssadd))
  264.     (foreach TMP NEWLST
  265.         (setq NEWSE (ssadd (handent (cadr TMP)) NEWSE))
  266.     )
  267.     ;;返回值
  268.     NEWSE
  269. ) ;_结束defun


RTX截图未命名.png

评分

参与人数 2D豆 +10 收起 理由
newer + 5 很给力!经验；技术要点；资料分享奖！
marting + 5 很给力!经验；技术要点；资料分享奖！

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

lisp_beginner

已领礼包: 10个

财富等级: 恭喜发财
发表于 2018-12-6 11:55:15 | 显示全部楼层
谢谢楼主，好人
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

hch8682005

已领礼包: 71个

财富等级: 招财进宝
发表于 2018-12-6 19:41:46 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
谢谢楼主，好人
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

zml84

已领礼包: 2个

财富等级: 恭喜发财
发表于 2019-10-1 16:02:58 | 显示全部楼层
本帖最后由 zml84 于 2019-10-1 16:05 编辑

1、手工带帽，是各苦力活。楼主这又是何苦呢。。
2、可能是行业习惯不同，台阶坡向内外有别。
3、引用他人的通用函数，建议还是保留原作者信息。是基本素养。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-4-27 04:29 , Processed in 0.358083 second(s), 38 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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