[已解决]求一个偏移指定间距的平行线的简单LISP程序
本帖最后由 raimo 于 2011-3-25 07:45 编辑我想要一个简单的LISP程序,请这里的大侠们帮帮忙:期待高手们不要嫌弃,指点一下,先谢过啦!!
具体要求是这样的..
1.先选择 已经存在的两条平行线,
2.然后给出一个指定的数值..
3.最后在这两条平行线之间自动偏移出这个指定数值大小两条新的平行线
(当然其中包含了数据检查,如果是负数,不能生成新平行线)
举例:
比如我已经有两条相距300mm的平行线,现需要用程序分别向内偏移一定的数值(程序自己计算),
让新生成的两条平行线之间的间距为60.
就是这样的一个小程序,希望高手们帮帮忙...
那么久的帖都被找到啦，不错，谢谢了。但不知道可否增加或改成也可以向外偏移的呢，谢谢哦 本帖最后由 langjs 于 2011-3-24 09:00 编辑
楼主要的是不是这个程序？程序按３楼要求更新
;;; =================================================================
(defun C:PX (/ a dist dist1 ent1 ent2 name1 name2 pt1 pt2 pt3 pt4)
(setvar "cmdecho" 0) ; 关闭命令响应
(setq $orr *error*)
(setq *error* #err2) ; 当程序出错时就会执行#err函数
(command ".UNDO" "BE") ; 设置UNDO起点
(setq t 1)
(while (= t 1)
(if (setq name1 (car (entsel "\n选择第一条直线：")))
(progn
(setq ent1 (entget name1))
(if (= (cdr (assoc 0 ent1)) "LINE")
(progn
(setq PT1 (cdr (assoc 10 ent1)))
(setq PT2 (cdr (assoc 11 ent1)))
(redraw name1 3)
(setq t 2)
)
)
)
)
)
(while (= t 2)
(if (setq name2 (car (entsel "\n选择第二条直线：")))
(progn
(setq ent2 (entget name2))
(if (= (cdr (assoc 0 ent2)) "LINE")
(progn
(setq PT3 (cdr (assoc 10 ent2)))
(setq PT4 (cdr (assoc 11 ent2)))
(if (= (distance PT1 (vlax-curve-getclosestpointto name2 PT1 t)) (distance PT3 (vlax-curve-getclosestpointto name1 PT3 t)))
(progn
(setq dist (distance PT1 (vlax-curve-getclosestpointto name2 PT1 t)))
(redraw name2 3)
(setq t 3)
)
(princ "\n选择的直线不平行，重新选择第二条直线：")
)
)
)
)
)
)
(while (= t 3)
(if (= chanshu001 nil)
(setq chanshu001 100.0)
)
(setq dist1 (getreal (strcat "\n输入新的平行线距离(应 <" (rtos dist 2) " ) <" (rtos chanshu001 2) ">:")))
(cond
((null dist1)
(setq dist1 chanshu001)
)
((= dist1 0.0)
(setq dist1 chanshu001)
)
(t
(setq chanshu001 dist1)
)
)
(if (< dist1 dist)
(progn
(setq a (/ (- dist dist1) 2))
(command "OFFSET" a name1 PT3 name2 PT1 "")
(setq t 4)
)
(princ "\n距离超过原平行线，请重新输入新的平行线距离：")
)
)
(redraw name1 4)
(redraw name2 4)
(command ".UNDO" "E") ; 设置UNDO终点
(setq *error* $orr)
(princ)
)
;;; 出错处理函数
(defun #err2 (s)
(command ".UNDO" "E") ; 设置UNDO终点
(redraw name1 4)
(redraw name2 4)
(princ)
(setq *error* $orr)
)
非常感谢啦,您这个程序已经能满足我的想法了..太好了
就是有一点,如果点直线的时候点偏了或者没有选中,就会提示如下的问题
选择第一条直线：; 错误: *error* 函数中出错参数类型错误: lentityp nil (princ "\n选择第一条直线：")
(while (not (setq ss (ssget ":S" '((0 . "LINE"))))))
这样可以确保选到线 (也有可能多于一条) Andyhon 这个没有看明白,不知道怎么加进去! 能再帮我弄一下吗? raimo 发表于 2011-3-23 22:16 static/image/common/back.gif
Andyhon 这个没有看明白,不知道怎么加进去! 能再帮我弄一下吗?
我已经更新过了，你重新试一试 langjs 发表于 2011-3-23 22:21 static/image/common/back.gif
我已经更新过了，你重新试一试
已经试过了,已经解决这个问题啦..非常感谢!!
还增加了自动提示 默认的新平行线距离,这个很棒!我之前也有这个想法的..
但是能设置默认一个固定大小吗?比如60?现在的是默认原平行线距离..
每次都要去修改还是不方便.
而且命令用后出现大堆命令提示....这些能去掉吗?
当前设置: 删除源=否图层=源OFFSETGAPTYPE=0
指定偏移距离或 [通过(T)/删除(E)/图层(L)] <30.0000>:90.00000000000000
选择要偏移的对象，或 [退出(E)/放弃(U)] <退出>:
指定要偏移的那一侧上的点，或 [退出(E)/多个(M)/放弃(U)] <退出>:
选择要偏移的对象，或 [退出(E)/放弃(U)] <退出>:
指定要偏移的那一侧上的点，或 [退出(E)/多个(M)/放弃(U)] <退出>:
选择要偏移的对象，或 [退出(E)/放弃(U)] <退出>:
命令: .UNDO 当前设置: 自动 = 关，控制 = 全部，合并 = 是，图层 = 是
输入要放弃的操作数目或 [自动(A)/控制(C)/开始(BE)/结束(E)/标记(M)/后退(B)] <1>: E
命令: 回复 raimo 的帖子
(setvar "cmdecho" 1)
--->
(setvar "cmdecho" 0)
試試看 raimo 发表于 2011-3-23 23:37 static/image/common/back.gif
已经试过了,已经解决这个问题啦..非常感谢!!
还增加了自动提示 默认的新平行线距离,这个很棒!我之前也有 ...
已经更新了，试试 langjs 的这次更新使得这个小程序完美的实现了我的想法,
非常非常的谢谢你的热心帮助!!!
页:
[1]
2