yjr111大师的两个程序求改编！
;;; Byyjr111 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)
)
)
自己顶起来~ 这个问题并不难，可以自己试着去实现你的想法
第一只需要在ssget后边的过滤表里边加上2组就行
第二个问题要复杂些，ssget"C"的地方需要自己写一个不受显示范围影响的函数来实现（这类例子论坛里边较多），也可以先对屏幕进行缩放后选择，选择完后恢复（这是最简单也很有效和办法）
另外，如果这两个程序都是你自己的，可以直接帮你改了，但是你自己不能一点思路都没有，而这一点比付费或者悬赏更重要！ ;;;程序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)
)
) 高手出手那纯属娱乐。只是热心帮忙 谢谢。一定要顶出高手谢谢。一定要顶出高手 思路：
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)求得两点距离。根据距离判断基点是否在线上。 谢谢。一定要顶出高手 谢谢。一定要顶出高手谢谢。一定要顶出高手 不错的帖子 支持一下
页:
[1]
2