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

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [求助]：請教:怎樣判斷兩個選擇集是否相等? ...
1234下一页
返回列表 发新帖
楼主: taner

[求助] [求助]：請教:怎樣判斷兩個選擇集是否相等?

  [复制链接]
taner

已领礼包: 2个

财富等级: 恭喜发财
 楼主| 发表于 2005-10-18 19:09:11 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
我沒在富士康呆過.但我確實是搞LCD開發的.我有同事在富士康.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
发表于 2005-10-18 19:47:27 | 显示全部楼层
最初由 taner 发布
[B]十分感謝各位的指點!終於搞定了一個難題.再次感謝!
(但是,如果有一個選擇集爲空時,各位程序運行提示出錯,因爲 (setq ss1 (ssget "x" (list (cons 8 c) (cons 0 "LINE,ARC,*POLYLINE"))))
  (setq ss2 (ssget "x" (... [/B]

简化版：
  2. [FONT=courier new](defun c:xxx (/ z c ss n e1)
  3.   (setq z (getvar "cmdecho"))
  4.   (setvar "cmdecho" 0)
  5.   (command "undo" "be")
  6.   (setq        c (getstring "\n請输入要聚合的层名<或回車點選要聚合的層中的任一實體>:"))
  7.   (if (= c "")
  8.     (setq c (cdr (assoc 8 (entget (car (entsel "\n請點選目標層實體:"))))))
  9.   )
  10.   (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "LINE,ARC,*POLYLINE"))))
  11.     (command "pedit" "M" ss "" "Y" "j" "" "")
  12.   )
  13.   (setq        ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE")))
  14.         n  -1
  15.   )
  16.   (while (setq e1 (ssname ss (setq n (1+ n))))
  17.     (if        (= (cdr (assoc 70 (entget e1))) 1)
  18.       (command "change" e1 "" "p" "c" 1 "")
  19.       (command "change" e1 "" "p" "c" 30 "")
  20.     )
  21.   )
  22.   (setvar "cmdecho" z)
  23.   (command "undo" "e")
  24.   (princ)
  25. )[/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

eachy

已领礼包: 593个

财富等级: 财运亨通
发表于 2005-10-18 19:52:59 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
当 选择中没有 Line 或者 Arc 时，Pedit 的 M 选项将不提示 Y
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

taner

已领礼包: 2个

财富等级: 恭喜发财
 楼主| 发表于 2005-10-18 22:03:43 | 显示全部楼层
確實簡單多了.加一句,解決:当 选择中没有 Line 或者 Arc 时，Pedit 的 M 选项将不提示 Y
[php]
(defun c:xxx (/ z c ss n e1)
  (setq z (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (setq c (getstring "\n請输入要聚合的层名<或回車點選要聚合的層中的任一實體>:"))
  (if (= c "")
    (setq c (cdr (assoc 8 (entget (car (entsel "\n請點選目標層實體:"))))))
  )
  (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "LINE,ARC"))))
    (if (/= ss nil)
      (command "pedit" "M" ss "" "Y" "j" "" "")
    )
  )
  (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE"))))
    (command "pedit" "M" ss "" "j" "" "")
  )
  (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE")))
        n -1
  )
  (while (setq e1 (ssname ss (setq n (1+ n))))
    (if (= (cdr (assoc 70 (entget e1))) 1)
      (command "change" e1 "" "p" "c" 1 "")
      (command "change" e1 "" "p" "c" 30 "")
    )
  )
  (setvar "cmdecho" z)
  (command "undo" "e")
  (princ)
)[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

eachy

已领礼包: 593个

财富等级: 财运亨通
发表于 2005-10-19 00:13:15 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
闭合、非闭合Pline用过滤器即可。
[php]
(defun c:xxx (/ z c ss )
  (setq z (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (if
    (and (setq
           c
            (getstring
              "\n請输入要聚合的层名<或回車點選要聚合的層中的任一實體>:"
            )
         )
         (if (and (= c "")
                  (setq e (car (entsel "\n請點選目標層實體:")))
             )
           (setq c (cdr (assoc 8 (entget e))))
           c
         )
    )
     (progn
       (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "LINE,ARC"))))
         (command ".pedit" "M" ss "" "Y" "j" "" "")
       )
       (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE"))))
         (command ".pedit" "M" ss "" "j" "" "")
       )
       (if (setq ss (ssget "x"
                           (list (cons 8 c)
                                 '(0 . "*POLYLINE")
                                 '(-4 . "&=")
                                 '(70 . 1)
                           )
                    )
           )
         (command ".chprop" ss "" "c" 1 "")
       )
       (if (setq ss (ssget "x"
                           (list (cons 8 c)
                                 '(0 . "*POLYLINE")
                                 '(-4 . "<not")
                                 '(-4 . "&=")
                                 '(70 . 1)
                                 '(-4 . "not>")
                           )
                    )
           )
         (command ".chprop" ss "" "c" 30 "")
       )
     )
  )
  (setvar "cmdecho" z)
  (command "undo" "e")
  (princ)
)[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
发表于 2005-10-19 08:24:15 | 显示全部楼层
  2. [FONT=courier new](defun c:xxx (/ z c ss)
  3.   (setq z (getvar "cmdecho"))
  4.   (setvar "cmdecho" 0)
  5.   (command "undo" "be")
  6.   (if (= (setq c (getstring "\n請输入要聚合的层名<回车點選目標層實體>:"))"")
  7.     (setq c (cdr (assoc 8 (entget (car (entsel "\n請點選目標層實體:"))))))
  8.   )
  9.   (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "LINE,ARC"))))
  10.     (command "pedit" "M" ss "" "Y" "j" "" "")
  11.   )
  12.   (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE"))))
  13.     (command "pedit" "M" ss "" "j" "" "")
  14.   )
  15.   (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE") '(70 . 1))))
  16.     (command "change" ss "" "p" "c" 1 "")
  17.   )
  18.   (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE") '(70 . 0))))
  19.     (command "change" ss "" "p" "c" 30 "")
  20.   )
  21.   (command "undo" "e")
  22.   (setvar "cmdecho" z)
  23.   (princ)
  24. )[/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

snoopychen
发表于 2005-10-19 10:04:13 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
本来觉得eachy版主的想法不错,只要ss1 r ss2为nil,然后ss2 r ss1为nil就可以判别ss1=ss2
但是不知道怎么获取这个为nil的选择集,
接着觉得可以用ssdel来从ss2中减去ss1,再从ss1中减去ss2,但没有编出很好的程序
于是利用一下stdlib的函数,是下面的程序,这个应该可以小改得到集合a>b,集合a<b,集合a交b,和集合a并b,大概可以类似xyp版主的ssunion
[php]
;;测试程序
(defun c:test()
(prompt "\n the first set ")
(setq ss1 (ssget))
(prompt "\n the second set ")
(setq ss2 (ssget))
(prompt " ")
(setq res (seta=b ss1 ss2))
)

;;对比两个表的元素是否相同，好像有点繁复
(defun seta=b(ss1 ss2 / flag flag1 ss1-list ss2-list result)
(setq flag 0 flag1 0 result T)
(setq ss1-list (std-sslist ss1) ss2-list (std-sslist ss2))
(foreach x ss1-list (if (not (member x ss2-list)) (setq flag 1)))
(foreach y ss2-list (if (not (member y ss1-list)) (setq flag1 1)))
(if (or (= flag 1) (= flag1 1)) (setq result nil))
result
)

;;利用Reini Urban编写的选择集变为表的子函数
(defun STD-SSLIST (ss / n lst)
  (if (eq 'PICKSET (type ss))
    (repeat (setq n (fix (sslength ss)))        ; fixed
      (setq lst (cons (ssname ss (setq n (1- n))) lst))))
)
[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
发表于 2005-10-19 12:11:53 | 显示全部楼层
最初由 snoopychen 发布
[B]本来觉得eachy版主的想法不错,只要ss1 r ss2为nil,然后ss2 r ss1为nil就可以判别ss1=ss2
但是不知道怎么获取这个为nil的选择集,
接着觉得可以用ssdel来从ss2中减去ss1,再从ss1中减去ss2,但没有编出很好的程序
于?.. [/B]

自我感觉没有比下面的“容易理解和简单”的了。
  2. [FONT=courier new]
  3. (defun comp-ss (ss1 ss2 / a b c)
  4.   (command "select" ss1 ss2 "")                ;ss1与ss2的并集
  5.   (setq        a (sslength (ssget "P"))
  6.         b (sslength ss1)
  7.         c (sslength ss2)
  8.   )
  9.   (if (and (= a b)                        ;并集ss3的数量与子集ss1的数量相等
  10.            (= a c)                        ;并集ss3的数量与子集ss2的数量相等
  11.       )
  12.     t
  13.     nil
  14.   )
  15. )[/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

taner

已领礼包: 2个

财富等级: 恭喜发财
 楼主| 发表于 2005-10-19 14:27:10 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

又有速度問題

[php](defun c:x1 (/ z c ss t1 t1 time1 tim2 dtime h m s)
  (setq z (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (if (and
        (setq c (getstring "\n請输入要聚合的层名<或回車點選要聚合的層中的任一實體>:"))
        (if (and
              (= c "")
              (setq e (car (entsel "\n請點選目標層實體:")))
            )
          (setq c (cdr (assoc 8 (entget e))))
          c
        )
      )
    (progn
      (setq t1 (rtos (getvar "cdate") 2 16))
      (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "LINE,ARC"))))
        (command ".pedit" "M" ss "" "Y" "j" "" "")
      )
      (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE"))))
        (command ".pedit" "M" ss "" "j" "" "")
      )
      (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE") '
                                    (-4 . "&=") '(70 . 1)
                              )
                   )
          )
        (command ".chprop" ss "" "c" 7 "")
      )
      (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE") '
                                    (-4 . "<not") '(-4 . "&=") '(70 . 1) '
                                    (-4 . "not>")
                              )
                   )
          )
        (command ".chprop" ss "" "c" 30 "")
      )
    )
  )
  (setq t2 (rtos (getvar "cdate") 2 16))
  (setq time1 (+ (* (atof (substr t1 10 2)) 3600) (* (atof (substr t1 12 2))
                                                     60
                                                  ) (/ (atof
                                                             (substr t1 14 4)
                                                       ) 100
                                                    )
              )
  )
  (setq time2 (+ (* (atof (substr t2 10 2)) 3600) (* (atof (substr t2 12 2))
                                                     60
                                                  ) (/ (atof
                                                             (substr t2 14 4)
                                                       ) 100
                                                    )
              )
  )
  (setq dtime (- time2 time1))
  (setq h (rtos (/ dtime 3600) 2 0)
        m (rtos (/ (rem dtime 3600) 60) 2 0)
        s (rtos (rem (rem dtime 3600) 60) 2 2)
  )
  (princ (strcat "\n用时 : " h " 小时" m " 分" s " 秒"))
  (command "undo" "e")
  (setvar "cmdecho" z)
  (princ)
)
(defun c:x2 (/ z c ss n e1 t1 t1 time1 tim2 dtime h m s)
  (setq z (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (setq c (getstring "\n請输入要聚合的层名<或回車點選要聚合的層中的任一實體>:"))
  (if (= c "")
    (setq c (cdr (assoc 8 (entget (car (entsel "\n請點選目標層實體:"))))))
  )
  (setq t1 (rtos (getvar "cdate") 2 16))
  (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "LINE,ARC"))))
    (if (/= ss nil)
      (command "pedit" "M" ss "" "Y" "j" "" "")
    )
  )
  (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE"))))
    (command "pedit" "M" ss "" "j" "" "")
  )
  (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE")))
        n -1
  )
  (while (setq e1 (ssname ss (setq n (1+ n))))
    (if (= (cdr (assoc 70 (entget e1))) 1)
      (command "change" e1 "" "p" "c" 30 "")
      (command "change" e1 "" "p" "c" 7 "")
    )
  )
  (setq t2 (rtos (getvar "cdate") 2 16))
  (setq time1 (+ (* (atof (substr t1 10 2)) 3600) (* (atof (substr t1 12 2))
                                                     60
                                                  ) (/ (atof
                                                             (substr t1 14 4)
                                                       ) 100
                                                    )
              )
  )
  (setq time2 (+ (* (atof (substr t2 10 2)) 3600) (* (atof (substr t2 12 2))
                                                     60
                                                  ) (/ (atof
                                                             (substr t2 14 4)
                                                       ) 100
                                                    )
              )
  )
  (setq dtime (- time2 time1))
  (setq h (rtos (/ dtime 3600) 2 0)
        m (rtos (/ (rem dtime 3600) 60) 2 0)
        s (rtos (rem (rem dtime 3600) 60) 2 2)
  )
  (princ (strcat "\n用时 : " h " 小时" m " 分" s " 秒"))
  (command "undo" "e")
  (setvar "cmdecho" z)
  (princ)
)
(defun c:x3 (/ z d c b k  t1 t1 time1 tim2 dtime h m s)
  (setq z (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (setq c (getstring "\n請输入要聚合的层名<或回車點選要聚合的層中的任一實體>:"))
  (if (= c "")
    (setq c (cdr (assoc 8 (entget (car (entsel "\n請點選目標層實體:"))))))
  )
  (setq t1 (rtos (getvar "cdate") 2 16))
  (while (setq a (ssget "x" (list (cons 8 c) (cons 0 "line,arc"))))
    (setq b (ssname a 0))
    (command "change" b "" "p" "c" 30 "")
    (command "pedit" b "y" "j" "all" "" "")
    (setq k (entlast))
    (if (/= (vlax-curve-isclosed k) t)
      (command "change" k "" "p" "c" 7 "")
    )
  )
  (setq t2 (rtos (getvar "cdate") 2 16))
  (setq time1 (+ (* (atof (substr t1 10 2)) 3600) (* (atof (substr t1 12 2))
                                                     60
                                                  ) (/ (atof
                                                             (substr t1 14 4)
                                                       ) 100
                                                    )
              )
  )
  (setq time2 (+ (* (atof (substr t2 10 2)) 3600) (* (atof (substr t2 12 2))
                                                     60
                                                  ) (/ (atof
                                                             (substr t2 14 4)
                                                       ) 100
                                                    )
              )
  )
  (setq dtime (- time2 time1))
  (setq h (rtos (/ dtime 3600) 2 0)
        m (rtos (/ (rem dtime 3600) 60) 2 0)
        s (rtos (rem (rem dtime 3600) 60) 2 2)
  )
  (princ (strcat "\n用时 : " h " 小时" m " 分" s " 秒"))
  (command "undo" "e")
  (setvar "cmdecho" z)
  (princ)
)
(defun c:x4 (/ z c ss  t1 t1 time1 tim2 dtime h m s)
  (setq z (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (if (= (setq c (getstring "\n請输入要聚合的层名<回车點選目標層實體>:"))
         ""
      )
    (setq c (cdr (assoc 8 (entget (car (entsel "\n請點選目標層實體:"))))))
  )
  (setq t1 (rtos (getvar "cdate") 2 16))
  (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "LINE,ARC"))))
    (command "pedit" "M" ss "" "Y" "j" "" "")
  )
  (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE"))))
    (command "pedit" "M" ss "" "j" "" "")
  )
  (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE") '(70 . 1))))
    (command "change" ss "" "p" "c" 7 "")
  )
  (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE") '(70 . 0))))
    (command "change" ss "" "p" "c" 30 "")
  )
  (setq t2 (rtos (getvar "cdate") 2 16))
  (setq time1 (+ (* (atof (substr t1 10 2)) 3600) (* (atof (substr t1 12 2))
                                                     60
                                                  ) (/ (atof
                                                             (substr t1 14 4)
                                                       ) 100
                                                    )
              )
  )
  (setq time2 (+ (* (atof (substr t2 10 2)) 3600) (* (atof (substr t2 12 2))
                                                     60
                                                  ) (/ (atof
                                                             (substr t2 14 4)
                                                       ) 100
                                                    )
              )
  )
  (setq dtime (- time2 time1))
  (setq h (rtos (/ dtime 3600) 2 0)
        m (rtos (/ (rem dtime 3600) 60) 2 0)
        s (rtos (rem (rem dtime 3600) 60) 2 2)
  )
  (princ (strcat "\n用时 : " h " 小时" m " 分" s " 秒"))
  (command "undo" "e")
  (setvar "cmdecho" z)
  (princ)
)[/php]
;| 以下是我對附件進行的測試

命令:x1
用时 : 0 小时2 分36.28 秒

命令: x2
用时 : 0 小时2 分36.33 秒

命令: x3
用时 : 0 小时0 分7.81 秒

命令: x4
用时 : 0 小时2 分36.67 秒

以上四個指令的功能完全相同.X3爲我以前編的(但是,有時會變形,不知道什麽原因,所以才想到換
一種方式寫一下).

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

使用道具 举报

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

使用道具 举报

aeo

已领礼包: 488个

财富等级: 日进斗金
发表于 2005-10-19 21:25:26 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
至少"select"有个很大的缺点是不能透明.

  3. ;;ssdel
  4. (defun s==s(ss1 ss2 / j)
  5.   (if(=(setq j(sslength ss1))(sslength ss2))
  6.      (progn(repeat j(ssdel(ssname ss1(setq j(1- j)))ss2))
  7.            (zerop(sslength ss2))
  8.    ))
  9. )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

eachy

已领礼包: 593个

财富等级: 财运亨通
发表于 2005-10-20 00:19:51 | 显示全部楼层
x1 这样改改
[php]
(defun xdl-getutime ()
  (* 86400 (getvar "tdusrtimer"))
)
(defun c:x1 (/ z c ss t1)
  (setq z (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (if (and
        (setq
          c (getstring
              "\n請输入要聚合的层名<或回車點選要聚合的層中的任一實體>:"
            )
        )
        (if (and
              (= c "")
              (setq e (car (entsel "\n請點選目標層實體:")))
            )
          (setq c (cdr (assoc 8 (entget e))))
          c
        )
      )
    (progn
      (setq t1 (xdl-getutime))
      (if (setq
            ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE,LINE,ARC")))
          )
        (if (ssget "P" '((0 . "LINE,ARC")))
          (command ".pedit" "M" ss "" "Y" "j" "" "")
          (command ".pedit" "M" ss "" "j" "" "")
        )
      )
      (if (setq        ss (ssget "x"
                          (list        (cons 8 c)
                                '(0 . "*POLYLINE")
                                '(-4 . "&=")
                                '(70 . 1)
                          )
                   )
          )
        (command ".chprop" ss "" "c" 7 "")
      )
      (if (setq        ss (ssget "x"
                          (list        (cons 8 c)
                                '(0 . "*POLYLINE")
                                '(-4 . "<not")
                                '(-4 . "&=")
                                '(70 . 1)
                                '(-4 . "not>")
                          )
                   )
          )
        (command ".chprop" ss "" "c" 30 "")
      )
    )
  )
  (princ "\n用时 : ")
  (princ (- (xdl-getutime) t1))
  (princ "s!")         
  (command "undo" "e")
  (setvar "cmdecho" z)
  (princ)
)[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

taner

已领礼包: 2个

财富等级: 恭喜发财
 楼主| 发表于 2005-10-20 09:08:11 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
[php](defun c:x9 (/ ss ss-ent ent-p i z t1 t2 dtime h m s)
  (setq z (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (setq c (getstring "\n請输入要聚合的层名<或回車點選要聚合的層中的任一實體>:"))
  (if (= c "")
    (setq c (cdr (assoc 8 (entget (car (entsel "\n請點選目標層實體:"))))))
  )
  (setq t1 (* 86400 (getvar "tdusrtimer")))
  (setq ss (ssget "x" (list (cons 8 c) (cons 0 "LINE,ARC"))))
  (if (/= nil ss)
    (progn
      (setq i 0)
      (while (< i (sslength ss))
        (setq ss-ent (ssname ss i))
        (setq ent-p (cdr (assoc 0 (entget ss-ent))))
        (if (not (null ent-p))               ; 判断原图元是否已串入多义线
          (command "pedit" ss-ent "y" "j" ss "" "")
        )
        (setq i (1+ i))
      )
    )
  )
  (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE") '(70 . 0))))
  (if (/= nil ss)
    (progn
      (setq i 0)
      (while (< i (sslength ss))
        (setq ss-ent (ssname ss i))
        (setq ent-p (cdr (assoc 0 (entget ss-ent))))
        (if (not (null ent-p))               ; 判断原图元是否已串入多义线
          (command "pedit" ss-ent "j" ss "" "")
        )
        (setq i (1+ i))
      )
    )
  )
  (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE") '(70 . 1))))
    (command "change" ss "" "p" "c" 30 "")
  )
  (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE") '(70 . 0))))
    (command "change" ss "" "p" "c" 7 "")
  )
  (setq t2 (* 86400 (getvar "tdusrtimer")))
  (setq dtime (- t2 t1))
  (setq h (rtos (/ dtime 3600) 2 0)
        m (rtos (/ (rem dtime 3600) 60) 2 0)
        s (rtos (rem (rem dtime 3600) 60) 2 2)
  )
  (princ (strcat "\n用时 : " h " 小时" m " 分" s " 秒"))
  (command "undo" "e")
  (setvar "cmdecho" z)
  (princ)
)[/php]
;上面的程序運行速度快,且沒有變形了.
謝謝各位的指點.
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xyp1964
发表于 2005-10-20 12:42:43 | 显示全部楼层
利用自定义函数set-start-time和princ-used-time，测试程序时间，到底哪个快：
  2. [FONT=courier new](load "xyp_lib")
  3. ;|加载通用函数(可在签名栏直接下载)
  4. 如果已经下载xyp_lib并放到搜索路径下可以不再下载!
  5. 利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
  6. ★1·在acad.lsp中增加(load"xyp_lib")
  7. ■2·在每个程序内增加(load"xyp_lib")
  8. ■3·在command下，输入(load"xyp_lib")
  9. ■4·在菜单.mnl中增加(load"xyp_lib")
  10. ■5·将xyp_lib.vlx文件直接拽到cad屏幕
  11. [COLOR=red] ★通用函数下载地址：[/COLOR]
  12. [url]http://www.xdcad.net/forum/attachment.php?s=&postid=1606661[/url]
  13. [url]http://www.mjtd.com/bbs/dispbbs.asp?boardID=3&ID=37554&page=1[/url]|;

  15. (defun c:x9 (/ c ss)
  16.   (cmdla0)
  17.   (if (= (setq c (getstring "\n请输入要聚合的层名<回车点选目标层实体>:"))"")
  18.     (setq c (cdr (assoc 8 (entget (car (entsel "\n请点选目标层实体:"))))))
  19.   )
  20.   (set-start-time)
  21.   (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "LINE,ARC"))))
  22.     (command "pedit" "M" ss "" "Y" "j" "" "")
  23.   )
  24.   (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE"))))
  25.     (command "pedit" "M" ss "" "j" "" "")
  26.   )
  27.   (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE") '(70 . 1))))
  28.     (command "change" ss "" "p" "c" 30 "")
  29.   )
  30.   (if (setq ss (ssget "x" (list (cons 8 c) '(0 . "*POLYLINE") '(70 . 0))))
  31.     (command "change" ss "" "p" "c" 7 "")
  32.   )
  33.   (princ-used-time)
  34.   (cmdla1)
  35. )[/FONT]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-11-15 23:33 , Processed in 0.272902 second(s), 52 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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