设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 学习编的绘制示坡线小程序，效率不高
返回列表 发新帖
查看: 2909|回复: 2

学习编的绘制示坡线小程序，效率不高

[复制链接]
lujoo
发表于 2009-8-14 15:11:00 | 显示全部楼层 |阅读模式
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;示坡线绘制程序1.0;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;                                                                                     ;;
  4. ;;   1、本程序的功能为绘制垂直于已知线段的示坡线。                                     ;;
  5. ;;                                                                                     ;;
  6. ;;   2、程序主命令为"SPX",在命令行中输入"SPX"按提示使用即可。                          ;;
  7. ;;                                                                                     ;;
  8. ;;                                                                     2009.8.14       ;;
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  13. (vl-load-com);载入com，以使本程序可以使用VLisp函数
  16. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  17. ;;                                 定义主命令函数"SPX"                                 ;;
  18. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  19. (defun C:SPX()
  20.       ;;预处理部分
  21.       (command "_.UNDO" "Group");设置后退起点
  22.       (setq old_cmd (getvar "cmdecho"))
  23.       (setq old_osm (getvar "osmode"))
  24.     (setvar "cmdecho" 0)
  25.     ;;开始执行
  26.       (setq pd (entsel "选取坡顶线："))
  27.       (setq pdx (car pd))
  28.       (if (vlax-curve-isClosed pdx)
  29.             (prompt "\n选取的是闭合曲线，不支持！")
  30.           (progn
  31.               (setq pt1 (cadr pd))
  32.               (setq pt2 (getpoint "指定一点确定示坡线的长度及方向："))
  33.               (setvar "osmode" 0);关闭捕捉
  34.               (setq isleft_pt2 (isLeft pt2 pdx));判断是否在线的左侧
  35.               (setq d (getreal "指定示坡线间距[5]："))
  36.               (if d
  37.                   (setq d d)
  38.                   (setq d 5.0)
  39.               )
  40.               (setq len (distance pt1 pt2))
  41.               (setq endpoint (vlax-curve-getEndPoint pdx))
  42.               (setq l (vlax-curve-getDistAtPoint pdx endpoint))
  43.               (setq dis 0)
  44.               (setq key -0.25);区分长短线
  45. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; (while (<= dis (- l d))
  46. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; (progn ;;progn2
  47. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; (setq dis (+ dis d))
  48. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; ;取得示坡线位于坡顶的端点point1_spx
  49. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; (setq point1_spx (vlax-curve-getPointAtDist pdx dis))
  50. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; ;取得point1_spx处曲线的切向矢量
  51. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; (setq firstDriv (vlax-curve-getFirstDeriv pdx (vlax-curve-getParamAtDist pdx dis)))
  52. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; (setq
  53. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160; deriv_x&#160; (car firstDriv)
  54. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160; deriv_y&#160; (cadr firstDriv)
  55. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; )
  56. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; (setq&#160; deriv_l (sqrt (+ (* deriv_x deriv_x) (* deriv_y deriv_y))))
  57. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; (setq
  58. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; point2_x1 (/ deriv_x deriv_l)
  59. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; point2_y1 (/ deriv_y deriv_l)
  60. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; )
  61. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; (setq
  62. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160; point1_x&#160; (car point1_spx)&#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160;
  63. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160; point1_y&#160; (cadr point1_spx)
  64. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; )
  65. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; (setq leng (+ (* len 0.75) (* len key)))
  66. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; (setq
  67. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160; point2_x&#160; (+ point1_x (* point2_x1 leng))
  68. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160; point2_y&#160; (+ point1_y (* point2_y1 leng))
  69. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; )
  70. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; ;;绘制示坡线
  71. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; (command "line" (list point1_x point1_y) (list point2_x point2_y) "")
  72. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; (if (= isleft_pt2 1)
  73. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160; (command "rotate" "L" "" point1_spx "90")
  74. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; (command "rotate" "L" "" point1_spx "-90")
  75. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; );;if
  76. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; &#160;&#160;&#160; &#160; (setq key (* -1.0 key));切换长短线
  77. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; &#160;&#160;&#160; &#160; );;progn2
  78. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; );;while
  79. &#160;&#160;&#160; &#160;&#160;&#160;&#160;&#160; );;progn
  80. &#160;&#160;&#160; &#160;&#160; );;if
  81. &#160;&#160;&#160; &#160; ;;结束部分
  82. &#160;&#160;&#160; &#160; (setvar "cmdecho" old_cmd)
  83. &#160;&#160;&#160; (setvar "osmode" old_osm)
  84. &#160;&#160;&#160; (command "_.UNDO" "End");设置后退终点
  85. &#160;&#160;&#160; (redraw)
  86. &#160;&#160;&#160; &#160; (princ)
  87. )
  89. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  90. ;;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; 定义命令别名"示坡线"&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160;&#160; ;;
  91. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  92. (defun C:示坡线()
  93. &#160;&#160;&#160; &#160; (C:SPX)
  94. )
  96. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  97. ;; 定义isLeft函数，功能为判断线外一点是否在曲线左侧，若在左侧，则返回"1"，反之返回"0"&#160; ;;
  98. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  99. (defun isLeft(pt_given curve)
  100. &#160;&#160;&#160; &#160; (setq pt_get (vlax-curve-getClosestPointTo curve pt_given))
  101. &#160;&#160;&#160; &#160; (setq para_get (vlax-curve-getParamAtPoint curve pt_get))
  102. &#160;&#160;&#160; &#160; (setq deriv_given (vlax-curve-getFirstDeriv curve para_get))
  103. &#160;&#160;&#160; (command "line" pt_given pt_get "")
  104. &#160;&#160;&#160; (setq line_get (entlast))
  105. &#160;&#160;&#160; (command "rotate" line_get "" pt_get "-90")
  106. &#160;&#160;&#160; (setq ax_line_get (vlax-ename->vla-object line_get))&#160;&#160;&#160; &#160;
  107. &#160;&#160;&#160; (setq deriv_get (vlax-curve-getFirstDeriv ax_line_get 1))
  108. &#160;&#160;&#160; (setq L1 (cadr deriv_given) L2 (car deriv_given))
  109. &#160;&#160;&#160; (setq M1 (cadr deriv_get) M2 (car deriv_get))
  110. &#160;&#160;&#160; (if (and (>= (* L1 M1) 0.0) (equal (/ L2 L1) (/ M2 M1) 0.0001))
  111. &#160;&#160;&#160; &#160;&#160;&#160; &#160; (setq yon 0)
  112. &#160;&#160;&#160; &#160;&#160;&#160; &#160; (setq yon 1)
  113. &#160;&#160;&#160; );;if
  114. &#160;&#160;&#160; (entdel line_get)
  115. &#160;&#160;&#160; yon
  116. )
回复

使用道具 举报

gcho
发表于 2009-9-1 17:11:00 | 显示全部楼层

经典，谢谢分享！

回复 支持 反对

使用道具 举报

gzbccy
发表于 2011-1-10 13:00:57 | 显示全部楼层
学习了，谢谢
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-10-2 18:23 , Processed in 0.180614 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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