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

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [LISP程序]：截断线自动绘制程序
返回列表 发新帖
查看: 745|回复: 7

[LISP程序]：截断线自动绘制程序

[复制链接]
人在天涯
发表于 2003-10-23 10:55:15 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
截断线自动绘制程序
断线, 绘制, 自动

相关帖子

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

使用道具 举报

2002zjp
发表于 2003-10-23 10:58:15 | 显示全部楼层
提醒大家是   jdx.vlx
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

hxy-xdcad
发表于 2003-10-23 14:48:23 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
请问截断线是指什么？
断线, 绘制, 自动

相关帖子

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

使用道具 举报

lukern
发表于 2003-10-24 17:41:25 | 显示全部楼层
请问该程序具体起什么作用?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

lt_zzy
发表于 2003-10-24 17:51:53 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
一楼的朋友，你的程序很好。
下面我也上传一个，我的这个可以在14下面使用，但是只能画水平和垂直方向的折断线。

  3.   [FONT=courier new]
  4. (defun c:zdx()
  5.    (setq os (getvar "osmode"))
  6.    (setvar "cmdecho"0)
  7.    (setq plw (getvar "plinewid"))
  8.    (setvar "plinewid" 0)
  9.    (command "undo""group")
  10.   (princ"只画水平和竖直的折断线")
  11. (setq pt2 (getpoint "\nPlease click the first  point(选择断面线的第一个边缘点):"))
  12. (setq pt7 (getpoint pt2 "\nPlease click the second point(选择地面线的另一边缘点):"))
  13. (setq bl (getreal "\nPlease enter the scale(请输入比例)<10>:"))
  14. (if (null bl)
  15.   (progn
  16.      (setq bl 10)
  17.   ))
  18.   (setq bl (/ bl 10))
  19.    (setvar "osmode"0)
  20. (setq dx (- (car pt2) (car pt7)))
  21. (setq dy (- (cadr pt2) (cadr pt7)))
  22. (if (<= (abs dx) (abs dy))
  23.    (progn
  24.      (setq  pt3 (list (car pt2) (+ (- (cadr pt2) (/ dy 2.0)) (* 1.5 bl))))
  25.      (setq  pt4 (list (+ (car pt3) (* 1 bl)) (cadr pt3)))
  26.      (setq  pt5 (list (- (car pt4) (* 2 bl)) (- (cadr pt4) (* 3 bl))))
  27.      (setq  pt6 (list (+ (car pt5) (* 1 bl)) (cadr pt5)))
  28.      (setq  pt8 (list (car pt2) (cadr pt7)))
  29.    )
  30.    (progn
  31.      (setq  pt3 (list (- (car pt2) (/ dx 2.0) (* 1.5 bl)) (cadr pt2)))
  32.      (setq  pt4 (list (+ (car pt3) 0) (+ (cadr pt3) (* 1 bl))))
  33.      (setq  pt5 (list (+ (car pt4) (* 3 bl)) (- (cadr pt4) (* 2 bl))))
  34.      (setq  pt6 (list (+ (car pt5) 0) (+ (cadr pt5) (* 1 bl))))
  35.      (setq  pt8 (list (car pt7) (cadr pt2)))
  36.    )
  37. )
  38. (if (or (and (< (abs dy) (abs dx))(< dx 0)) (and (> (abs dy) (abs dx))(> dy 0)))
  39.    (progn
  40.      (command "pline" pt2 pt3 pt4 pt5 pt6 pt8 "")
  41.    )
  42.    (progn
  43.      (command "pline" pt2 pt6 pt5 pt4 pt3 pt8 "")
  44.    )
  45. )
  46. (command "undo""end")
  47. (setvar "cmdecho" 1)
  48. (setvar "plinewid" plw)
  49. (setvar"osmode"os)
  50. (princ)
  51. )
  52.   [/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

zhynt
发表于 2003-10-24 19:39:16 | 显示全部楼层
再来看看我的截断线：

  3. (defun C:jdx(/ lay pt1 pt2 dis x1 pt3 pt4 pt5 pt6  n ss ptt scale)
  4.   (setvar "CMDECHO" 0)
  5.   (setq lay (getvar "clayer"))
  6.   (setq osan (getvar "osmode"))  
  7.   (command "color" "bylayer")
  8.   (command "layer" "m" "jdx" "c" "m" "jdx" "")
  9.   (setq scale (getreal "\n比例<100>:"))
  10.   (if (= scale nil) (setq scale 100))
  11.   (setq pt1 (getpoint "\n起始点:"))
  12.   (setq pt2 (getpoint pt1 "\n结束点:"))
  13.   (setq ang (angle pt1 pt2))
  14.   (setq dis (distance pt1 pt2))
  15.   (setq x1 (/ (- dis (* 2 scale)) 2))
  16.   (setq pt3 (polar pt1 ang x1))
  17.   (setq pt4 (polar pt1 ang (+ x1 (* 2 scale))))
  18.   (setq pt5 (polar pt3 (+ ang 1.32582) (* 2.0616 scale)))
  19.   (setq pt6 (polar pt4 (- ang 1.81577) (* 2.0616 scale)))
  20.   (setvar "osmode" 0)
  21.   (command "pline" pt1 "w" "0" "0" pt3 pt5 pt6 pt4 pt2 "")
  22.   (setq n (getstring "\n是否偏移 y <n>"))
  23.   (if (or (= n "y")(= n "Y"))
  24.       (progn
  25.         (setq ptt (polar pt1 (- ang (/ pi 2)) (* 1 scale)))
  26.         (setq ss (entlast))
  27.         (command "copy" ss "" pt1 ptt)
  28.       )
  29.   )
  30.   (command "layer" "s" lay "")
  31.   (setvar "osmode" osan)
  32.   (princ)(princ)
  33. )  
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

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

使用道具 举报

whfdchst
发表于 2006-3-2 10:00:31 | 显示全部楼层
请问斑竹，程序结尾处为什么用两个(princ)(princ)？
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2025-9-29 04:03 , Processed in 0.453386 second(s), 49 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

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