shiyan001 发表于 2014-2-9 23:08:20

学习学习!!!!,看看G版的里面有没有我需要的。

扶风 发表于 2014-2-16 16:35:37

这个楼中楼还需回复才能看，也就是需要才回复了

峰峰兒 发表于 2014-2-17 09:05:11

liuhaixin88 发表于 2014-2-17 09:21:55

进来看看

masterlong 发表于 2014-2-21 04:25:05

今晚上失眠了

(defun v13_getalltkbox( / tkbss x box i )
        (setq tkbss (ssget "x" '((0 . "insert")(2 . "QGY_V13_TK-*")(-4 . "!=")(62 . 250))))                ;;图块名称根据需要修改
        (setq tkbss (ss2list tkbss))
        (setq *alltkbox* '())
        (foreach x tkbss
                (setq box (entbox x))
                (setq *alltkbox* (cons (list box x) *alltkbox*))
        )
        *alltkbox*        ;;全局参数
)

(defun v13_po_seltk_1_new( thepo / temp po pa pb bbox btkb loop )
        (if (setq btkb Nil
                               po (if thepo
                                               thepo
                                               (getpoint "\n 请在目标图框内部点击...")
                                      )
               )
                (progn
                        (setq loop T i (length *alltkbox*))
                        (while loop
                                (setq bbox (car (nth (setq i (1- i)) *alltkbox*)))
                                (setq pa (car bbox) pb (cadr bbox))
                                (if (and (<= (carpa) (carpo) (carpb))
                                                        (<= (cadr pa) (cadr po) (cadr pb))
                                       )
                                       (setq loop (vla-ZoomScaled (vlax-get-acad-object) 1.1 acZoomScaledRelative)
                                                      loop (vla-ZoomPrevious (vlax-get-acad-object))
                                                      loop Nil
                                                      btkb (cadr (nth i *alltkbox*))
                                       )
                                       (if (= i 0) (setq loop Nil))
                                )
                        )
                        btkb
                )
        )
        btkb
)

;;选择集转为图元列表
(defun ss2list( ss )
        (if (= 'PICKSET (type ss))
                (reverse (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex ss))))
        )
)

;;单个图元包围盒
(defun entbox( ent / ll ur )
        (vla-getboundingbox (vlax-ename->vla-object ent) 'll 'ur)
        (mapcar 'vlax-safearray->list (list ll ur))
)



;;使用方法
;|
(v13_getalltkbox)
(setq seltkb (v13_po_seltk_1_new nil))
|;

chenjian2159 发表于 2014-2-25 21:08:36

看看，谢谢

zmx6189 发表于 2014-5-17 17:52:31

学习一下如何

hnfsf 发表于 2014-5-18 09:06:32

看G版大作，认真学习。。。

chenshulu 发表于 2014-11-16 17:26:08

单击一个图框块里面一点，得到此图框的边界。

tsgang 发表于 2015-5-24 23:30:53

研究一下G版本的程序
页: 1 2 3 4 5 6 [7] 8 9 10 11
查看完整版本: 如何通过块内一点得到该块所有组成图元名？