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

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › 管道双断开符号，强烈表扬logo3490 ，佩服！！ ...
12下一页
返回列表 发新帖
查看: 2845|回复: 26

管道双断开符号，强烈表扬logo3490 ，佩服！！

[复制链接]
lsjzhj2004
发表于 2006-10-18 23:02:28 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
这个程序是生成管道的双断开线，样子详见附图！

最完美程序在15楼，非常佩服logo3490  ！！强烈请求版主给予加分鼓励！！！
管道, 开线, logo3490

相关帖子

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

使用道具 举报

phoenixdjq
发表于 2006-10-19 16:54:38 | 显示全部楼层
你的这个程序只能从上到下选择点，而且两点连线的角度为90度才能成立。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

logo3490
发表于 2006-10-19 18:54:37 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
  2. (defun c:test (/)

  4.         (initget 1)(setq p1 (getpoint "\n First point: "))
  5.         (initget 1)(setq p2 (getpoint p1 "\n First point: "))


  8.         (if (/= 'REAL  (type logocad:pipe_size)) (setq logocad:pipe_size 100))

  10.         (setq
  11.                 msg                (strcat "\n PIPE SIZE <" (rtos logocad:pipe_size 2 2) ">: ")
  12.                 tmp                (getreal msg)
  13.         ) ; end setq
  14.         (if (and (not (null tmp))(numberp tmp)(> tmp 0)) (setq logocad:pipe_size tmp))

  16.         (setq
  17.                 ang                (angle p1 p2)
  18.                 perang1        (+ ang (/ pi 2.0))
  19.                 perang2        (- ang (/ pi 2.0))
  20.                 offsz        (/ logocad:pipe_size 2)
  21.                 dp1                (polar p1 perang1 offsz)
  22.                 dp2                (polar p2 perang1 offsz)
  23.                 dp3                (polar p1 perang2 offsz)
  24.                 dp4                (polar p2 perang2 offsz)
  25.                 plist        (list (list dp1 dp2) (list dp3 dp4))

  27.                 rdst        (/ logocad:pipe_size 4)
  28.                 ang1        (angle p1 dp1)
  29.                 ang2        (angle p1 p2)
  30.                 ang3        (angle p1 dp3)

  32.                 xdata        (list
  33.                                 (list p1 dp1 ang1 ang2 nil T)
  34.                                 (list p1 dp1 ang1 (+ pi ang2) T nil)
  35.                                 (list dp3 p1 ang1 ang2 nil nil)

  37.                                 (list p2 dp2 ang1 (+ pi ang2) T nil)
  38.                                 (list dp4 p2 ang1 (+ pi ang2) T T)
  39.                                 (list dp4 p2 ang1 ang2 nil nil)

  41.                                 ) ; end list

  43.                 rad                (* (- 1 0.125) rdst)
  44.         ) ; end setq

  46.         (foreach dat plist
  47.                 (entmake         (list
  48.                                         (cons 0         "LINE")
  49.                                         (cons 8         (getvar "CLAYER"))
  50.                                         (cons 10         (car dat))
  51.                                         (cons 11         (cadr dat))))
  52.         ) ; end foreach

  54.         (foreach dat xdata
  55.                 (setq
  56.                         ref_p1        (nth 0 dat)
  57.                         ref_p2        (nth 1 dat)
  58.                         ang1        (nth 2 dat)
  59.                         ang2        (nth 3 dat)
  60.                         tmp                (polar ref_p1 ang1 rdst)
  61.                         cen                (polar tmp ang2 rad)
  62.                         rad2        (distance cen ref_p1)
  63.                         ang1        (angle cen ref_p1)
  64.                         ang2         (angle cen ref_p2)
  65.                 ) ; end setq
  66.                 (if (null (nth 4 dat)) (setq tmp ang1 ang1 ang2 ang2 tmp tmp nil))
  67.                 (entmake
  68.                         (list
  69.                                 (cons 0                "ARC")
  70.                                 (cons 8         (getvar "CLAYER"))
  71.                                 (cons 62         (if (null (nth 5 dat)) 0 1))
  72.                             (cons 10         cen)
  73.                             (cons 40         rad2)
  74.                             (cons 50         ang1)
  75.                             (cons 51         ang2)))

  77.         ) ; end foreach
  78.         (princ)

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

使用道具 举报

lsjzhj2004
 楼主| 发表于 2006-10-19 18:57:27 | 显示全部楼层
最初由 phoenixdjq 发布
[B]你的这个程序只能从上到下选择点，而且两点连线的角度为90度才能成立。 [/B]

3楼的朋友编的程序，挺好用，但往往生成这种断开符时，管道线已经画好了，不知道怎么才能实现这个在已经画好的管道线上生成这种断开符呢
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

Underway

已领礼包: 7501个

财富等级: 富甲天下
发表于 2006-10-19 20:31:50 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
  2. ;; No error check
  3. (defun C:aa()
  4.    (vl-load-com)
  5.    (setvar "cmdecho" 0)
  6.    (setq ivar (getvar "osmode"))
  7.    (setq e1 (entsel "\n 请输入第一条线: ")
  8.          e2 (entsel "\n 请输入第二条线: ")
  9.          e1 (car e1)
  10.          e2 (car e2)
  11.          ss (ssadd)
  12.    )
  13.    (ssadd e1 ss)
  14.    (ssadd e2 ss)
  15.    (setq pts (acet-geom-ss-extents ss T)      ; supported by ET
  16.          pt1 (car  pts)
  17.          pt3 (cadr pts)
  18.          pt2 (list (car pt3) (cadr pt1))
  19.          pt4 (list (car pt1) (cadr pt3))
  20.          <90 (/ Pi 2)
  21.           dd (/ (distance pt2 pt3) 2)
  22.          pt5 (polar pt2 <90 dd)
  23.           dd (/ dd 2)
  24.         pta1 (polar (polar pt2 <90 dd) 0.0 (/ dd 2))
  25.         pta2 (polar (polar pt5 <90 dd) Pi (/ dd 2))
  26.           ss (ssadd)
  27.    )
  28.    (setvar "osmode" 0)
  29.    (vl-cmdf "pline" pt2 "A" "S" pta1 pt5 pta2 pt3 "")
  30.    (ssadd (entlast) ss)
  31.    (vl-cmdf "pline" pt3 "A" "S" (polar pta2 0.0 dd) pt5 "")
  32.    (ssadd (entlast) ss)
  33.    (vl-cmdf "copy" ss "" pt3 pt3)
  34.    (vl-cmdf "move" ss "" pt3 pt1)
  35.    (vl-cmdf "rotate" ss "" pt1 180)
  36.    (setvar "cmdecho" 1)
  37.    (setvar "osmode" ivar)
  38.    (princ)
  39. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

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

使用道具 举报

logo3490
发表于 2006-10-19 22:03:13 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
好人做到底了!
也不用那麼麻煩啦，抓那兩條線的對角點即可

  3. (defun c:test (/)


  6.         (setq old_osmode (getvar "OSMODE"))
  7.         (setvar "OSMODE" 1)
  8.         (initget 1)(setq p1 (getpoint "\n First point: "))
  9.         (initget 1)(setq p2 (getpoint p1 "\n First point: "))
  10.         (setvar "OSMODE" old_osmode)

  12.         (setq elist (apply 'append
  13.                                 (mapcar '(lambda (pt_data)
  14.                                         (setq ss (ssget "X" (list (cons 0 "LINE")(cons -4 "\<OR")(cons 10 pt_data)(cons 11 pt_data)(cons -4  "OR\>"))))
  15.                                         (list (if (null ss) nil (ssname ss 0)))
  16.                                 ) (list p1 p2) )))

  18.         (if (not (and (car elist) (cadr elist))) (exit))

  20.         (setq
  21.                 e                (car elist)
  22.                 ex                (entget e)
  23.                 dp1                (cdr (assoc 10 ex))
  24.                 dp2                (cdr (assoc 11 ex))

  26.                 e                (cadr elist)
  27.                 ex                (entget e)
  28.                 dp3a        (cdr (assoc 10 ex))
  29.                 dp4a        (cdr (assoc 11 ex))

  31.                 ang                (angle dp1 dp2)
  32.                 perang1        (+ ang (/ pi 2.0))
  33.                 perang2        (- ang (/ pi 2.0))
  34.                 dp3                (inters dp3a dp4a dp1 (polar dp1 perang1 1) nil)
  35.                 dp4                (inters dp3a dp4a dp2 (polar dp2 perang1 1) nil)

  37.                 wid                (distance dp1 dp3)
  38.                 offsz        (/ wid 2)
  39.                 p1                (polar dp1 (angle dp1 dp3) offsz)
  40.                 p2                (polar dp2 (angle dp1 dp3) offsz)

  42.                 rdst        (/ wid 4)
  43.                 ang1        (angle p1 dp1)
  44.                 ang2        (angle p1 p2)
  45.                 ang3        (angle p1 dp3)

  47.                 xdata        (list p1 p2)
  48.                 rad                (* (- 1 0.125) rdst)

  50.                 pdata        nil

  52.         ) ; end setq

  54.         (command "_UNDO" "BEGIN")

  56.         (foreach base xdata
  57.                 (foreach angx (list perang1 perang2)
  58.                         (setq
  59.                                 cen                (polar (polar base angx rdst) (+ angx (/ pi 2.0)) rad)
  60.                                 rad2        (distance cen base)
  61.                                 ang1        (angle cen base)
  62.                                 ang2         (angle cen (polar base angx (* rdst 2)))
  63.                                 pdata        (append pdata (list (list cen rad2 ang1 ang2)))
  64.                         ) ; end setq
  65.                 ) ; end foreach
  66.                 (setq swang (if (equal swang perang1) perang2 perang1))
  67.                 (setq
  68.                         cen                (polar (polar base swang rdst) (- swang (/ pi 2.0)) rad)
  69.                         rad2        (distance cen base)
  70.                         ang1        (angle cen base)
  71.                         ang2         (angle cen (polar base swang (* rdst 2)))
  72.                         pdata        (append pdata (list (list cen rad2 ang2 ang1)))
  73.                 ) ; end setq
  74.         ) ; end foreach

  76.         (foreach dat pdata
  77.                 (entmake
  78.                         (list
  79.                                 (cons 0                "ARC")
  80.                                 (cons 8         (getvar "CLAYER"))
  81.                                 (cons 62         (if (null (nth 5 dat)) 0 1))
  82.                             (cons 10         (nth 0 dat))
  83.                             (cons 40         (nth 1 dat))
  84.                             (cons 50         (nth 2 dat))
  85.                             (cons 51         (nth 3 dat))))
  86.         ) ; end foreach

  88.         (command "_UNDO" "END")
  89.         (princ)

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

使用道具 举报

lsjzhj2004
 楼主| 发表于 2006-10-19 22:38:16 | 显示全部楼层 |阅读模式

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

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

×
谢谢楼上的朋友，但不知道你的程序是哪里掉东西了，
管道, 开线, logo3490

相关帖子

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

使用道具 举报

logo3490
发表于 2006-10-19 23:11:59 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
程式碼中有 HTML 的字元，所以就被剪掉了
改用附件好了，再試試
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

lsjzhj2004
 楼主| 发表于 2006-10-19 23:33:18 | 显示全部楼层
最初由 logo3490 发布
[B]程式碼中有 HTML 的字元，所以就被剪掉了
改用附件好了，再試試 [/B]


我用过了，能用了，但是和你所描述的不太一样，还是只能捕捉两条线上的两个端点才能生成，这样有局限性，我觉得如果捕捉两条线上的任意两个点，就在这两个点处生成，那样就比较好用了，即你所说，选取对角点即可生成断开符。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

logo3490
发表于 2006-10-19 23:49:58 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
那就改成這樣子

(defun c:test (/)


        (setq old_osmode (getvar "OSMODE"))
        (setvar "OSMODE" 512)

        (while (null (setq e1 (entsel))))
        (while (null (setq e2 (entsel))))

        (setvar "OSMODE" old_osmode)

        (setq
                e                (car e1)
                ex                (entget e)
                dp1a        (cdr (assoc 10 ex))
                dp2a        (cdr (assoc 11 ex))
                lay                (cdr (assoc 8 ex))

                ang                (angle dp1a dp2a)
                perang1        (+ ang (/ pi 2.0))
                perang2        (- ang (/ pi 2.0))
                p1                (cadr e1)
                p2                (cadr e2)
                dp1                (inters dp1a dp2a p1 (polar p1 perang1 1) nil)
                dp2                (inters dp1a dp2a p2 (polar p2 perang1 1) nil)

                e                (car e2)
                ex                (entget e)
                dp3a        (cdr (assoc 10 ex))
                dp4a        (cdr (assoc 11 ex))
                dp3                (inters dp3a dp4a p1 (polar p1 perang1 1) nil)
                dp4                (inters dp3a dp4a p2 (polar p2 perang1 1) nil)

                wid                (distance dp1 dp3)
                offsz        (/ wid 2)
                p1                (polar dp1 (angle dp1 dp3) offsz)
                p2                (polar dp2 (angle dp1 dp3) offsz)

                rdst        (/ wid 4)
                ang1        (angle p1 dp1)
                ang2        (angle p1 p2)
                ang3        (angle p1 dp3)

                xdata        (list p1 p2)
                rad                (* (- 1 0.125) rdst)

                pdata        nil

        ) ; end setq

        (command "_UNDO" "BEGIN")

        (foreach base xdata
                (foreach angx (list perang1 perang2)
                        (setq
                                cen                (polar (polar base angx rdst) (+ angx (/ pi 2.0)) rad)
                                rad2        (distance cen base)
                                ang1        (angle cen base)
                                ang2         (angle cen (polar base angx (* rdst 2)))
                                pdata        (append pdata (list (list cen rad2 ang1 ang2)))
                        ) ; end setq
                ) ; end foreach
                (setq swang (if (equal swang perang1) perang2 perang1))
                (setq
                        cen                (polar (polar base swang rdst) (- swang (/ pi 2.0)) rad)
                        rad2        (distance cen base)
                        ang1        (angle cen base)
                        ang2         (angle cen (polar base swang (* rdst 2)))
                        pdata        (append pdata (list (list cen rad2 ang2 ang1)))
                ) ; end setq
        ) ; end foreach

        (foreach dat pdata
                (entmake
                        (list
                                (cons 0                "ARC")
                                (cons 8         lay)
                            (cons 10         (nth 0 dat))
                            (cons 40         (nth 1 dat))
                            (cons 50         (nth 2 dat))
                            (cons 51         (nth 3 dat))))
        ) ; end foreach

        (command "_UNDO" "END")
        (princ)

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

使用道具 举报

lsjzhj2004
 楼主| 发表于 2006-10-20 07:13:14 | 显示全部楼层
高手就是高手，做的相当的好，非常好用。你这种思路非常不错，谢谢！！不过如果能把生成的这两个断开符分别生成两个组，我感觉就会更完美了，因为那样操作起来会相当的方便。另外，在运行过程中，并且多段线不能操作。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

logo3490
发表于 2006-10-20 20:23:09 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
修改, PLINE 也可以, 及兩個符號變成 BLOCK

(defun c:test (/)


        (setq old_osmode (getvar "OSMODE"))
        (setvar "OSMODE" 512)

        (while (null (setq e1 (entsel))))
        (while (null (setq e2 (entsel))))

        (setvar "OSMODE" old_osmode)

        (setq
                e                (car e1)
                ex                (entget e)
                lay                (cdr (assoc 8 ex))
                ename        (cdr (assoc 0 ex))
                cap                (cadr e1)
                p1                 nil
                dst                -1
        ) ; end setq

        (cond
                ((= ename "LINE")
                        (setq
                                dp1a        (cdr (assoc 10 ex))
                                dp2a        (cdr (assoc 11 ex))
                        )) ; end setq
                ((= ename "LWPOLYLINE")
                        (while (and ex (setq p2 (assoc 10 ex)))
                                (setq
                                        ex        (cdr (member p2 ex))
                                        p2        (cdr p2)
                                        xp        (if p1 (inters p1 p2 cap (polar cap (+ (angle p1 p2) (/ pi 2.0)) 1) nil) nil)
                                        tmp        (if xp (distance cap xp) -1)
                                ) ; end setq
                                (if (or (minusp dst) (< tmp dst)) (setq dst tmp dp1a p1 dp2a p2 ))
                                (setq         p1         p2)
                        )) ; end while
                (T (exit))
        ) ; end cond


        (setq
                e                (car e2)
                ex                (entget e)
                ename        (cdr (assoc 0 ex))
                cap                (cadr e2)
                p1                 nil
                dst                -1
        ) ; end setq

        (cond
                ((= ename "LINE")
                        (setq
                                dp3a        (cdr (assoc 10 ex))
                                dp4a        (cdr (assoc 11 ex))
                        )) ; end setq
                ((= ename "LWPOLYLINE")
                        (while (and ex (setq p2 (assoc 10 ex)))
                                (setq
                                        ex        (cdr (member p2 ex))
                                        p2        (cdr p2)
                                        xp        (if p1 (inters p1 p2 cap (polar cap (+ (angle p1 p2) (/ pi 2.0)) 1) nil) nil)
                                        tmp        (if xp (distance cap xp) -1)
                                ) ; end setq
                                (if (or (minusp dst) (< tmp dst)) (setq dst tmp dp3a p1 dp4a p2 ))
                                (setq         p1         p2)
                        )) ; end while
                (T (exit))
        ) ; end cond


        (setq
                ang                (angle dp1a dp2a)
                perang1        (+ ang (/ pi 2.0))
                perang2        (- ang (/ pi 2.0))
                p1                (cadr e1)
                p2                (cadr e2)
                dp1                (inters dp1a dp2a p1 (polar p1 perang1 1) nil)
                dp2                (inters dp1a dp2a p2 (polar p2 perang1 1) nil)
                dp3                (inters dp3a dp4a p1 (polar p1 perang1 1) nil)
                dp4                (inters dp3a dp4a p2 (polar p2 perang1 1) nil)

                wid                (distance dp1 dp3)
                offsz        (/ wid 2)
                p1                (polar dp1 (angle dp1 dp3) offsz)
                p2                (polar dp2 (angle dp1 dp3) offsz)

                rdst        (/ wid 4)
                ang1        (angle p1 dp1)
                ang2        (angle p1 p2)
                ang3        (angle p1 dp3)

                xdata        (list p1 p2)
                rad                (* (- 1 0.125) rdst)

                pdata        nil

        ) ; end setq

        (command "_UNDO" "BEGIN")


        (foreach base xdata
                (foreach angx (list perang1 perang2)
                        (setq
                                cen                (polar (polar base angx rdst) (+ angx (/ pi 2.0)) rad)
                                rad2        (distance cen base)
                                ang1        (angle cen base)
                                ang2         (angle cen (polar base angx (* rdst 2)))
                                pdata        (append pdata (list (list cen rad2 ang1 ang2 "BYLAYER")))
                        ) ; end setq
                ) ; end foreach
                (setq swang (if (equal swang perang1) perang2 perang1))
                (setq
                        cen                (polar (polar base swang rdst) (- swang (/ pi 2.0)) rad)
                        rad2        (distance cen base)
                        ang1        (angle cen base)
                        ang2         (angle cen (polar base swang (* rdst 2)))
                        pdata        (append pdata (list (list cen rad2 ang2 ang1 "BYBLOCK")))
                ) ; end setq
        ) ; end foreach

        (entmake
                (list
                        (cons 0  "BLOCK")
                        (cons 2  "*U")
                        (cons 70 1)
                        (cons 10 dp1)
                )
        ) ; end entmake

        (foreach dat pdata
                (entmake
                        (list
                                (cons 0                "ARC")
                                (cons 8         lay)
                                (cons 6            (nth 4 dat) )
                            (cons 10         (nth 0 dat))
                            (cons 40         (nth 1 dat))
                            (cons 50         (nth 2 dat))
                            (cons 51         (nth 3 dat))))
        ) ; end foreach

        (entmake
                (list
                        (cons 0 "INSERT")
                        (cons 2 (entmake '((0 . "ENDBLK"))))
                        (cons 10 dp1)
                        (cons 50 0)
                        (cons 41 1)
                        (cons 42 1)
                )
        )

        (command "_UNDO" "END")
        (princ)

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

使用道具 举报

lsjzhj2004
 楼主| 发表于 2006-10-20 20:34:14 | 显示全部楼层
最初由 logo3490 发布
[B]修改, PLINE 也可以, 及兩個符號變成 BLOCK

(defun c:test (/)


        (setq old_osmode (getvar "OSMODE"))
        (setvar "OSMODE" 512)

        (while (null (setq e1 (entsel))))
        (while (null (setq e2 (entsel)))... [/B]


好用，很好用！不知能不能实现两个断开符，[B]分别[/COLOR] [/B]成块，或者是[B]分别[/COLOR] [/B]成组呢？成组最好，因为生成完断开符后，往往下一个操作便是剪切的命令，并且有时位置没有选好时，还要进行调整断开符的位置，如果能实现这两点的话，我想程序就相当的完美了。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

logo3490
发表于 2006-10-20 21:09:33 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
改修改

  3. (defun c:test (/)


  6.         (setq old_osmode (getvar "OSMODE"))
  7.         (setvar "OSMODE" 512)

  9.         (while (null (setq e1 (entsel))))
  10.         (while (null (setq e2 (entsel))))

  12.         (setvar "OSMODE" old_osmode)

  14.         (setq
  15.                 e                (car e1)
  16.                 ex                (entget e)
  17.                 lay                (cdr (assoc 8 ex))
  18.                 ename        (cdr (assoc 0 ex))
  19.                 cap                (cadr e1)
  20.                 p1                 nil
  21.                 dst                -1
  22.         ) ; end setq

  24.         (cond
  25.                 ((= ename "LINE")
  26.                         (setq
  27.                                 dp1a        (cdr (assoc 10 ex))
  28.                                 dp2a        (cdr (assoc 11 ex))
  29.                         )) ; end setq
  30.                 ((= ename "LWPOLYLINE")
  31.                         (while (and ex (setq p2 (assoc 10 ex)))
  32.                                 (setq
  33.                                         ex        (cdr (member p2 ex))
  34.                                         p2        (cdr p2)
  35.                                         xp        (if p1 (inters p1 p2 cap (polar cap (+ (angle p1 p2) (/ pi 2.0)) 1) nil) nil)
  36.                                         tmp        (if xp (distance cap xp) -1)
  37.                                 ) ; end setq
  38.                                 (if (or (minusp dst) (< tmp dst)) (setq dst tmp dp1a p1 dp2a p2 ))
  39.                                 (setq         p1         p2)
  40.                         )) ; end while
  41.                 (T (exit))
  42.         ) ; end cond


  45.         (setq
  46.                 e                (car e2)
  47.                 ex                (entget e)
  48.                 ename        (cdr (assoc 0 ex))
  49.                 cap                (cadr e2)
  50.                 p1                 nil
  51.                 dst                -1
  52.         ) ; end setq

  54.         (cond
  55.                 ((= ename "LINE")
  56.                         (setq
  57.                                 dp3a        (cdr (assoc 10 ex))
  58.                                 dp4a        (cdr (assoc 11 ex))
  59.                         )) ; end setq
  60.                 ((= ename "LWPOLYLINE")
  61.                         (while (and ex (setq p2 (assoc 10 ex)))
  62.                                 (setq
  63.                                         ex        (cdr (member p2 ex))
  64.                                         p2        (cdr p2)
  65.                                         xp        (if p1 (inters p1 p2 cap (polar cap (+ (angle p1 p2) (/ pi 2.0)) 1) nil) nil)
  66.                                         tmp        (if xp (distance cap xp) -1)
  67.                                 ) ; end setq
  68.                                 (if (or (minusp dst) (< tmp dst)) (setq dst tmp dp3a p1 dp4a p2 ))
  69.                                 (setq         p1         p2)
  70.                         )) ; end while
  71.                 (T (exit))
  72.         ) ; end cond


  75.         (setq
  76.                 ang                (angle dp1a dp2a)
  77.                 perang1        (+ ang (/ pi 2.0))
  78.                 perang2        (- ang (/ pi 2.0))
  79.                 p1                (cadr e1)
  80.                 p2                (cadr e2)
  81.                 dp1                (inters dp1a dp2a p1 (polar p1 perang1 1) nil)
  82.                 dp2                (inters dp1a dp2a p2 (polar p2 perang1 1) nil)
  83.                 dp3                (inters dp3a dp4a p1 (polar p1 perang1 1) nil)
  84.                 dp4                (inters dp3a dp4a p2 (polar p2 perang1 1) nil)

  86.                 wid                (distance dp1 dp3)
  87.                 offsz        (/ wid 2)
  88.                 p1                (polar dp1 (angle dp1 dp3) offsz)
  89.                 p2                (polar dp2 (angle dp1 dp3) offsz)

  91.                 rdst        (/ wid 4)
  92.                 ang1        (angle p1 dp1)
  93.                 ang2        (angle p1 p2)
  94.                 ang3        (angle p1 dp3)

  96.                 xdata        (list p1 p2)
  97.                 rad                (* (- 1 0.125) rdst)

  99.                 pdata        nil

  101.         ) ; end setq

  103.         (command "_UNDO" "BEGIN")


  106.         (foreach base xdata
  107.                 (foreach angx (list perang1 perang2)
  108.                         (setq
  109.                                 cen                (polar (polar base angx rdst) (+ angx (/ pi 2.0)) rad)
  110.                                 rad2        (distance cen base)
  111.                                 ang1        (angle cen base)
  112.                                 ang2         (angle cen (polar base angx (* rdst 2)))
  113.                                 pdata        (append pdata (list (list cen rad2 ang1 ang2 "BYLAYER")))
  114.                         ) ; end setq
  115.                 ) ; end foreach
  116.                 (setq swang (if (equal swang perang1) perang2 perang1))
  117.                 (setq
  118.                         cen                (polar (polar base swang rdst) (- swang (/ pi 2.0)) rad)
  119.                         rad2        (distance cen base)
  120.                         ang1        (angle cen base)
  121.                         ang2         (angle cen (polar base swang (* rdst 2)))
  122.                         pdata        (append pdata (list (list cen rad2 ang2 ang1 "BYBLOCK")))
  123.                 ) ; end setq
  124.         ) ; end foreach


  127.         (setq el (entlast))
  128.         (foreach dat pdata
  129.                 (entmake
  130.                         (list
  131.                                 (cons 0                "ARC")
  132.                                 (cons 8         lay)
  133.                                 (cons 6            (nth 4 dat) )
  134.                             (cons 10         (nth 0 dat))
  135.                             (cons 40         (nth 1 dat))
  136.                             (cons 50         (nth 2 dat))
  137.                             (cons 51         (nth 3 dat))))
  138.         ) ; end foreach

  140.         (setq ac_group (cdar (dictsearch (namedobjdict) "ACAD_GROUP")))
  141.         (entmake
  142.                 (list
  143.                 (cons 0                "GROUP")
  144.                 (cons 102        "{ACAD_REACTORS")
  145.                 (cons 330         ac_group)
  146.                 (cons 102        "}")
  147.                 (cons 100        "AcDbGroup")
  148.                 (cons 300        "*")
  149.                 (cons 70        0)
  150.                 (cons 71        1)
  151.                 (cons 340        (setq el (entnext el)))
  152.                 (cons 340        (setq el (entnext el)))
  153.                 (cons 340        (setq el (entnext el)))
  154.                 ) ;_ end of list
  155.         )

  157.         (entmake
  158.                 (list
  159.                 (cons 0                "GROUP")
  160.                 (cons 102        "{ACAD_REACTORS")
  161.                 (cons 330         ac_group)
  162.                 (cons 102        "}")
  163.                 (cons 100        "AcDbGroup")
  164.                 (cons 300        "*")
  165.                 (cons 70        0)
  166.                 (cons 71        1)
  167.                 (cons 340        (setq el (entnext el)))
  168.                 (cons 340        (setq el (entnext el)))
  169.                 (cons 340        (setq el (entnext el)))
  170.                 ) ;_ end of list
  171.         )

  173.         (command "_UNDO" "END")
  174.         (princ)

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2025-2-19 06:24 , Processed in 0.459646 second(s), 62 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

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