明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2059|回复: 3

求继续修改,把点选改成框选。

[复制链接]
发表于 2013-1-27 12:52:14 | 显示全部楼层 |阅读模式
1明经币
本帖最后由 weiqi 于 2013-1-27 13:14 编辑

http://bbs.mjtd.com/thread-100064-1-1.html
之前发过这个帖~得到相关LISP代码后,还不是非常理想。
现在 是点选 框,一次一 次点选,最后一次性输出。
我想得到一个是框选 然后一次性输出全部。
麻烦高手的修改一下。






附件: 您需要 登录 才可以下载或查看,没有账号?注册

最佳答案

查看完整内容

(defun c:cdx1 (/ lst ss lin data pts xx ens len n str strs pt-ins ptlst) (setvar "cmdecho" 0) (princ "\n选择方框:") (setq lst nil i -1) (setq ss (ssget (list (cons 0 "lwpolyline")))) (while (setq lin (ssname ss (setq i (1+ i)))) (setq data (entget lin) pts nil ) (foreach xx data (if (= 10 (car xx)) (setq pts (cons (cdr xx) pts)) ) ) ;;; ...
"觉得好,就打赏"
还没有人打赏,支持一下

本帖被以下淘专辑推荐:

  • · 88|主题: 1, 订阅: 0
发表于 2013-1-27 12:52:15 | 显示全部楼层
(defun c:cdx1 (/ lst ss lin data pts xx ens len n str strs pt-ins ptlst)
  (setvar "cmdecho" 0)
  (princ "\n选择方框<空格退出>:")
  (setq lst nil i -1)
  (setq ss (ssget (list (cons 0 "lwpolyline"))))
  (while (setq lin (ssname ss (setq i (1+ i))))
    (setq  data (entget lin)
           pts  nil
    )
    (foreach xx        data
      (if (= 10 (car xx))
        (setq pts (cons (cdr xx) pts))
      )
    )
;;;    (command ".zoom" "W" (car pts) (caddr pts))
    (setq ens (ssget "cp" pts '((0 . "TEXT") (8 . "E-PE,e-id"))))
;;;    (command ".zoom" "p")
    (or ens (setq ens (ssadd)))
    (setq len  (sslength ens)
          n    0
          strs nil
    )
    (while (< n len)
      (setq en         (ssname ens n)
            data (entget en)
      )
      (setq strs (cons (cons (cdr (assoc 10 data))
                             (strcat " " (cdr (assoc 1 data)))
                       )
                       strs
                 )
      )
      (setq n (1+ n))
    )
    (if        strs
      (progn
        (setq
          strs (vl-sort        strs
                        '(lambda (e1 e2) (> (cadar e1) (cadar e2)))
               )
        )
        (setq str "")
        (foreach xx strs (setq str (strcat str (cdr xx))))
        (initget 1)
        (setq lst (cons str lst))
      )
      (princ "\n不包含指定层文字!")
    )
    (princ "\n选择方框<空格退出>:")
  )
  (setq pt-ins (getpoint "\n指定一点:"))
  (setq ptlst nil)
  (repeat (setq n (length lst))
    (setq ptlst         (cons pt-ins ptlst)
          pt-ins (polar pt-ins (* 1.5 pi) 555)
    )
  )
  (mapcar '(lambda (x y)
             (entmake
               (list
                 '(0 . "TEXT")
                 '(100 . "AcDbEntity")
                 '(8 . "E-PE")
                 '(62 . 110)
                 '(100 . "AcDbText")
                 (cons 10 y)
                 '(40 . 444.444)
                 (cons 1 x)
                 '(41 . 0.7)
                 '(7 . "HZ")
               )
             )
           )
          lst
          ptlst
  )
  (setvar "cmdecho" 1)
  (princ)
)

点评

可以使用 谢谢咯  发表于 2013-1-28 23:54
回复

使用道具 举报

发表于 2013-1-27 13:06:41 | 显示全部楼层
链接给错了

点评

谢谢Z版提醒  发表于 2013-1-27 13:14
回复

使用道具 举报

 楼主| 发表于 2013-1-28 20:38:26 | 显示全部楼层
顶一下,望高手出手
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-22 21:03 , Processed in 0.191486 second(s), 30 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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