[求助]：自动把（双）折断线之间的线剪

szx025 · 发表于 2008-11-20 16:07:46

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

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

×

这是一个画（双）折断线的程序，请高手在此基础上增加剪切的功能，画完折断线后，鼠标往那边移动，就把折断线这边的线剪切掉，
对于（双）折断线，画完后自动把（双）折断线之间的线剪切掉
;;; ------------------------------------------------------------------
;;; jdx 画截断线
(defun C:jdx (/ lay pt1 pt2 dis x1 pt3 pt4 pt5 pt6 scale)
(setvar "CMDECHO" 0)
(setq lay (getvar "clayer"))
(command "color" "bylayer")
(command "layer" "m" "jdx" "c" "m" "jdx" "")
(setq scale (getreal "\nScale<300>:"))
(if (= scale nil)
(setq scale 300)
)
(setq pt1 (getpoint "\nFirst point:"))
(setq pt2 (getpoint pt1 "\nSecond point:"))
(setq ang (angle pt1 pt2))
(setq dis (distance pt1 pt2))
(setq x1 (/ (- dis (* 2 scale)) 2))
(setq pt3 (polar pt1 ang x1))
(setq pt4 (polar pt1 ang (+ x1 (* 2 scale))))
(setq pt5 (polar pt3 (+ ang 1.32582) (* 2.0616 scale)))
(setq pt6 (polar pt4 (- ang 1.81577) (* 2.0616 scale)))
(command "pline" pt1 "w" "0" "0" pt3 pt5 pt6 pt4 pt2 "")
(command "layer" "s" lay "")
(princ)
(princ)
)

;;; ------------------------------------------------------------------
;;; jdx2 画截断双线
(defun C:jdx2 (/ lay pt1 pt2 dis x1 pt3 pt4 pt5 pt6 ss ptt scale)
(setvar "CMDECHO" 0)
(setq lay (getvar "clayer"))
(command "color" "bylayer")
(command "layer" "m" "jdx" "c" "m" "jdx" "")
(setq scale (getreal "\nScale<300>:"))
(if (= scale nil)
(setq scale 300)
)
(setq pt1 (getpoint "\nFirst point:"))
(setq pt2 (getpoint pt1 "\nSecond point:"))
(setq ang (angle pt1 pt2))
(setq dis (distance pt1 pt2))
(setq x1 (/ (- dis (* 2 scale)) 2))
(setq pt3 (polar pt1 ang x1))
(setq pt4 (polar pt1 ang (+ x1 (* 2 scale))))
(setq pt5 (polar pt3 (+ ang 1.32582) (* 2.0616 scale)))
(setq pt6 (polar pt4 (- ang 1.81577) (* 2.0616 scale)))
(setq ptt (polar pt1 (- ang (/ pi 2)) (* 1 scale)))
(command "pline" pt1 "w" "0" "0" pt3 pt5 pt6 pt4 pt2 "")
(setq ss (entlast))
(command "copy" ss "" pt1 ptt)
(command "layer" "s" lay "")
(princ)
(princ)
)

bikeboy · 发表于 2008-12-3 13:05:02

写的还行支持一下

pdesign · 发表于 2008-12-11 23:42:18

同求

szx025 · 发表于 2008-12-12 08:00:13

没高人指导，我自己解决了，

pdesign · 发表于 2008-12-12 16:34:53

szx025 大侠
你上传的文件没有内容，能不能再传一下。谢谢了

szx025 · 发表于 2008-12-12 16:45:09

再来一次

szx025 · 发表于 2008-12-12 16:47:40

还是空的，再来试一次

pdesign · 发表于 2008-12-12 19:33:24

可能网站有问题了，都是空的。

能不能直接贴代码啊

感谢。。。

qiuxiang129 · 发表于 2008-12-13 00:28:19

哇～～～

pdesign · 发表于 2008-12-14 08:09:56

szx025 大哥。。。

szx025 · 发表于 2008-12-15 07:52:27

直接贴代码

(defun C:szx(/ pt1 pt2 dis x1 pt3 pt4 pt5 pt6 ptt pttt p1 p2 ang ang1 scale)
  ;;保存系统变量设置
  (setq old_OS  (getvar "OSMODE")
   old_CMD (getvar "CMDECHO")
   old_OR (getvar "OrthoMode")
)
  (setvar "CMDECHO" 0)
  (setvar "OSMODE" 0)
  (setvar "OrthoMode" 0)
  (setq scale (getreal "\nScale<100>:"))
(if (= scale nil)
(setq scale 100)
)
  (setq pt1 (getpoint "\nFirst point:"))
(setq pt2 (getpoint pt1 "\nSecond point:"))
(setq ang (angle pt1 pt2))
(setq dis (distance pt1 pt2))
(setq x1 (/ (- dis (* 2 scale)) 2))
(setq pt3 (polar pt1 ang x1))
(setq pt4 (polar pt1 ang (+ x1 (* 2 scale))))
(setq pt5 (polar pt3 (+ ang 1.32582) (* 2.0616 scale)))
(setq pt6 (polar pt4 (- ang 1.81577) (* 2.0616 scale)))
(setq ptt (polar pt1 (- ang (/ pi 2)) (* 1 scale)))
(setq pttt (polar pt2 (- ang (/ pi 2)) (* 1 scale)))
(command "_pline" pt1 ptt pttt pt2 "c" "")
(setq ee (entlast))
(command "_trim" ee "" "f" pt2 ptt  "" "")
  (entdel ee)
(command "pline" pt1 "w" "0" "0" pt3 pt5 pt6 pt4 pt2 "")
(setq ss (entlast))
(command "copy" ss "" pt1 ptt)
;;恢复系统变量设置
(setvar "CMDECHO" old_CMD)
(setvar "OSMODE" old_OS)
(setvar "OrthoMode" old_OR)
  (princ)(princ)
)

yh1998 · 发表于 2008-12-20 15:31:01

程序还不够完美，希望能人再完美下！剪切的路径因该是双断线的中线，不该只是两点一线，这个样对于复杂图形的折断，断线不够完美

pdesign · 发表于 2008-12-21 19:01:22

是啊。
思想是这样：将一条折线偏移0.1，求出这条新的折线各个顶点（多义线），剪切是延各个顶点剪，删除新偏移的折线。
（要更完美就是：剪切之前将与这两条折线相交的块也分解）。

不会写代码

xiangandqing · 发表于 2008-12-24 16:20:11

暂时还不懂,学习中

kmdz · 发表于 2008-12-28 16:16:49

试用了下，在折线处不能剪完，其它地方还行。

账号		自动登录	找回密码
密码			立即注册

[求助] [求助]：自动把（双）折断线之间的线剪

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

相关帖子

程序还不够完美，希望能人再完美下