明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2959|回复: 11

yjr111大师的两个程序求改编!

[复制链接]
发表于 2015-10-4 10:13 | 显示全部楼层 |阅读模式
50明经币

;;;     By  yjr111   http://bbs.mjtd.com/thread-99625-1-1.html
;;; -------------------------------------------------------------------------------------------------------------------
;;;程序1、选中直线或多段线则选中线及在线上的块
;;;目前希望完善的地方:并不是跟直线或PL线相交的所有图块都被选择,只有指定名称的一些图块能被选择。
(defun c:tt1 (/ E PLST SS )
  (setq mycad(vlax-get-acad-object))
  (IF (AND(setq E(car (entsel "\n选择直线或轻多义线: ")))
          (MEMBER (CDR(ASSOC 0(SETQ S(ENTGET E)))) (LIST "LINE" "LWPOLYLINE"))
          )
    (PROGN
       (vla-zoomall mycad)
       (FOREACH X S
        (IF (OR(=(CAR X)10)(=(CAR X)11))
          (SETQ PLST(CONS (CDR X)PLST))
        )
       )
      (setq ss (ssget "F" PLST'((0 . "insert"))))
      (if ss (progn(ssadd E ss)(sssetfirst ss ss))(princ"\n没有块被选中!"))      
    )
  )
  (vla-ZoomPrevious mycad)
  (princ)
)


;;;程序2、选中标注则选中与之相连的所有标注
;;;目前希望完善的地方:目前是只能选择视野范围内的标注,希望屏幕中没有显示的标注也能被选择。
(defun c:tt2 (/ E newss p13 p14 flag newp13 newp14)
  (defun dxf (code ename) (cdr (assoc code (entget ename))))
  (IF (AND (setq E (car (entsel "\n选择标注: ")))
           (eq (dxf 0 e) "DIMENSION")
      )
    (PROGN
      (setq newss (ssadd)oldss (ssadd))
      (ssadd e newss)
      (setq p13        (dxf 13 e)
            p14        (dxf 14 e)
      )
      (lj e p13)
      (setq flag nil)
      (lj e p14)
    )
  )
  (sssetfirst newss newss)
  (princ)
)
(defun lj (jze p / ss n )
  (setq        ss (ssget "c"
                  (mapcar '(lambda (x) (- x (getvar 'pickbox))) p)
                  (mapcar '(lambda (x) (+ x (getvar 'pickbox))) p)
                  '((0 . "dimension"))
           )
  )
  (if ss (ssdel jze ss))
  (if (and ss (> (sslength ss) 0)(not flag))
    (progn
      (setq n 0)
      (repeat (sslength ss)
        (setq ee (ssname ss n))
        (ssadd ee newss)
        (setq n (1+ n))
      )      
      (setq newp13(dxf 13 ee)
            newp14(dxf 14 ee)
      )
      (if (equal newp13 p 1e-1)
        (setq p newp14)
        (setq p newp13)
      )
      (lj ee p)
    )
    (setq flag t)
  )
)

评分

参与人数 1明经币 +1 收起 理由
wayne_myles + 1 好想法!

查看全部评分

 楼主| 发表于 2015-10-9 14:13 | 显示全部楼层
自己顶起来~
回复

使用道具 举报

发表于 2015-10-13 12:21 | 显示全部楼层
这个问题并不难,可以自己试着去实现你的想法
第一只需要在ssget后边的过滤表里边加上2组就行
第二个问题要复杂些,ssget"C"的地方需要自己写一个不受显示范围影响的函数来实现(这类例子论坛里边较多),也可以先对屏幕进行缩放后选择,选择完后恢复(这是最简单也很有效和办法)
另外,如果这两个程序都是你自己的,可以直接帮你改了,但是你自己不能一点思路都没有,而这一点比付费或者悬赏更重要!
回复

使用道具 举报

发表于 2016-2-1 09:25 | 显示全部楼层
;;;程序1、选中直线或多段线则选中线及在线上的块
;;;目前希望完善的地方:并不是跟直线或PL线相交的所有图块都被选择,只有指定名称的一些图块能被选择。
(defun c:tt1 (/ E PLST SS )
  (setq mycad(vlax-get-acad-object))
        (setq blkname (getstring"\n请输入快名:"))
  (IF (AND(setq E(car (entsel "\n选择直线或轻多义线: ")))
          (MEMBER (CDR(ASSOC 0(SETQ S(ENTGET E)))) (LIST "LINE" "LWPOLYLINE"))
          )
    (PROGN
       (vla-zoomall mycad)
       (FOREACH X S
        (IF (OR(=(CAR X)10)(=(CAR X)11))
          (SETQ PLST(CONS (CDR X)PLST))
        )
       )
      (setq ss (ssget "F" PLST (list '(0 . "INSERT") (cons 2 blkname))))
      (if ss (progn(ssadd E ss)(sssetfirst ss ss))(princ"\n没有块被选中!"))      
    )
  )
  (vla-ZoomPrevious mycad)
  (princ)
)

;;;程序2、选中标注则选中与之相连的所有标注
(defun c:tt2 (/ E newss p13 p14 flag newp13 newp14)
  (defun dxf (code ename) (cdr (assoc code (entget ename))))
  (IF (AND (setq E (car (entsel "\n选择标注: ")))
           (eq (dxf 0 e) "DIMENSION")
      )
    (PROGN
                        (setq mycad(vlax-get-acad-object))
                        (vla-ZoomPrevious mycad)
      (setq newss (ssadd)oldss (ssadd))
      (ssadd e newss)
      (setq p13        (dxf 13 e)
            p14        (dxf 14 e)
      )
      (lj e p13)
      (setq flag nil)
      (lj e p14)
                        (vla-ZoomPrevious mycad)
    )
  )
  (sssetfirst newss newss)
  (princ)
)
(defun lj (jze p / ss n )
  (setq        ss (ssget "c"
                  (mapcar '(lambda (x) (- x (getvar 'pickbox))) p)
                  (mapcar '(lambda (x) (+ x (getvar 'pickbox))) p)
                  '((0 . "dimension"))
           )
  )
  (if ss (ssdel jze ss))
  (if (and ss (> (sslength ss) 0)(not flag))
    (progn
      (setq n 0)
      (repeat (sslength ss)
        (setq ee (ssname ss n))
        (ssadd ee newss)
        (setq n (1+ n))
      )      
      (setq newp13(dxf 13 ee)
            newp14(dxf 14 ee)
      )
      (if (equal newp13 p 1e-1)
        (setq p newp14)
        (setq p newp13)
      )
      (lj ee p)
    )
    (setq flag t)
  )
)
回复

使用道具 举报

发表于 2016-2-26 17:14 | 显示全部楼层
高手出手那纯属娱乐。只是热心帮忙
回复

使用道具 举报

发表于 2016-2-27 17:11 | 显示全部楼层
谢谢。一定要顶出高手谢谢。一定要顶出高手
回复

使用道具 举报

发表于 2016-2-27 18:38 | 显示全部楼层
思路:
1.(ssget "X" (list '(0 . "INSERT") (cons 2 blkname)))选择块。
2.取得块的插入点&p1。
3.点选直线或多段线,转换为VLA对象&ob1。
4.(setq &p2 (vlax-curve-getclosestpointto &ob1 &p1));取得最近点。
5.(distance &p1 &p2)求得两点距离。根据距离判断基点是否在线上。
回复

使用道具 举报

发表于 2016-2-27 20:19 | 显示全部楼层
谢谢。一定要顶出高手
回复

使用道具 举报

发表于 2016-2-27 20:19 | 显示全部楼层
谢谢。一定要顶出高手谢谢。一定要顶出高手
回复

使用道具 举报

发表于 2018-12-5 12:59 | 显示全部楼层
不错的帖子 支持一下
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 10:38 , Processed in 0.237402 second(s), 25 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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