回复 669423907 的帖子
哎呦我的娘啊，上岁数了眼睛就花了！！
先下班回去看！
simon8001 发表于 2011-7-5 16:21 static/image/common/back.gif
各位兄弟 俺刚才试用了一下这个程序，如果两条直线不是互相垂直的情况，拉伸线交点就会不断的变化了，不知道 ...
那交点的问题处理一下就可以了，13楼已修改，支持不垂直的交线。。。。
回复 ljpnb 的帖子
大师真是精益求精啊！
回复 ljpnb 的帖子
大师是否方便帮看看 “色选+动态修改线型比例” 的程序呢？
好东东,顶顶
本帖最后由 myjping 于 2012-2-8 15:38 编辑
带捕捉的
(defun c:tes (/ distance1 PT dxf1 OBJ angle1 my)
(vl-load-com)
(setvar "CMDECHO" 0)
(setqmy 1)
;(get_osmode)
(while (= my 1)
(SETQ OBJ nil)
(while (not obj)(SETQ OBJ (ENTSEL "\n选择要延伸的直线....")))
(SETQ dxf1 (ENTGET (CAR OBJ)) PT (CaDR OBJ))
(SETQ ent (CAR OBJ))
(setq pt (vlax-curve-getClosestPointTo ent pt T))
(setq sss (cdr(assoc 0 dxf1)))
(if (= sss "LINE")(setqmy 0))
)
(setqmy 1)
(while (or(= my 1) (/= (car (setq mouse (grread mouse 5 0))) 3))
(setq p11 (vl-remove 10 (assoc 10 dxf1))
p12 (vl-remove 11 (assoc 11 dxf1))
)
(setqangle1 (angle p11 p12))
(setqdistance1 0)
(if (>(distance p11 pt)(distance p12 pt))(setq pt p12)(setq pt p11))
(while (or (/= 3 (car (setq n (grread t 4 3))))(/= 5 (car (setq n (grread t 4 3)))))
(setq pt1 (cadr n))
; (get_osmode)
; (get_osmode1 pt1)
;(grbox (pt1 my_str)
;(setq pt1 (if (osnap pt1 my_str) (osnap pt1 my_str)pt1))
(grreadosnap pt1)
; (setq pt1 (if (my_pt) (osnap pt1 my_str)pt1))
;(setq pt1 (if (osnap pt1 str) (osnap pt1 my_str)pt1))
;(setq pt1 (if (osnap pt1 "end,mid,cen,nod,qua,nea") (osnap pt1 "end,mid,cen,nod,qua,nea")pt1))
(if ptold
(grdraw ptold pt 0)
)
(grdraw pt1 pt 1)
(setq ptold pt1)
(setq myangle1 (angle pt pt1) )
(if (>(distance p11 pt)(distance p12 pt))
(progn
(setq myangle2 (angle p11 p12) )
(setq myangle (- myangle1 myangle2))
;(if(> myangle (* 1.5 pi) )(setq myangle (- myangle (* 1.5 pi)) ))
(setq cos1 (cosmyangle))
(setqdistance1 (* cos1 (distance ptold pt)))
; (if (> (/ pi 2) myangle) (setqdistance1 (distance ptold pt)) (setqdistance1 (-(distance ptold pt))))
; (setqdistance1 (* distance1 (abs(cos myangle ))))
(setqp14 (polar p12 angle1distance1 ))
(setq dxf1 (subst (cons 11 p14) (assoc 11 dxf1) dxf1))
(entmod dxf1)
)
(progn
(setq myangle2 (angle p12 p11) )
(setq myangle (- myangle1 myangle2))
(setq cos1 (cosmyangle))
(setqdistance1 (* cos1 (distance ptold pt)))
;(if(> myangle (* 1.5 pi) )(setq myangle (- myangle (* 1.5 pi)) ))
; (if (> (/ pi 2) myangle) (setqdistance1 (distance ptold pt)) (setqdistance1 (-(distance ptold pt))))
; (setqdistance1 (* distance1 (abs(cos myangle ))))
(setqp13 (polar p11 (+ angle1 pi )distance1 ))
(setq dxf1 (subst (cons 10 p13) (assoc 10 dxf1) dxf1))
(entmod dxf1)
)
)
)
(redraw)
(grdraw ptold pt 0)
(SETQ OBJ nil)
(SETQ OBJ (ENTSEL ""))
(if (= OBJ nil)(setqmy 0))
(SETQ dxf1 (ENTGET (CAR OBJ)) PT (CaDR OBJ))
(SETQ ent (CAR OBJ))
(setq pt (vlax-curve-getClosestPointTo ent pt T))
(setq sss (cdr(assoc 0 dxf1)))
(while (/= sss "LINE")
(SETQ OBJ (ENTSEL ""))
(SETQ dxf1 (ENTGET (CAR OBJ)) PT (CaDR OBJ))
(setq sss (cdr(assoc 0 dxf1)))
)
)
(princ)
)
(defun grreadosnap (p / osp osmode str)
;;grreadosnap ---fsxm 2006.10.06
(setq osmode (getvar "osmode"))
(cond ((= osmode 0))
((< osmode 16384)
(setq str "")
(foreach x '((1 "_end,")
(2 "_mid,")
(4 "_cen,")
(8 "_nod,")
(16 "_qua,")
(32 "_int,")
(64 "_ins,")
(128 "_per,")
(256 "_tan,")
(512 "_nea,")
(2048 "_app,")
(4096 "_ext,")
(8192 "_par,")
)
(if (/= 0 (logand osmode (car x)))
(setq str (strcat str (cadr x)))
)
)
;(setq pt1 (if (osnap pt1 str) (osnap pt1 my_str)pt1))
(setq osp (osnap p str))
(setq str1 nil)
(cond ((and (/= 0 (logand osmode 1)) (equal osp (osnap p "_end,"))) (setq str1 1))
((and (/= 0 (logand osmode 2)) (equal osp (osnap p "_mid,"))) (setq str1 2))
((and (/= 0 (logand osmode 4)) (equal osp (osnap p "_cen,"))) (setq str1 4))
((and (/= 0 (logand osmode 8)) (equal osp (osnap p "_nod,"))) (setq str1 8))
((and (/= 0 (logand osmode 16)) (equal osp (osnap p "_qua,"))) (setq str1 16))
((and (/= 0 (logand osmode 32)) (equal osp (osnap p "_int,"))) (setq str1 32))
((and (/= 0 (logand osmode 64)) (equal osp (osnap p "_ins,"))) (setq str1 64))
((and (/= 0 (logand osmode 128)) (equal osp (osnap p "_per,"))) (setq str1 128))
((and (/= 0 (logand osmode 256)) (equal osp (osnap p "_tan,"))) (setq str1 256))
((and (/= 0 (logand osmode 512)) (equal osp (osnap p "_nea,"))) (setq str1 512))
((and (/= 0 (logand osmode 2048)) (equal osp (osnap p "_app,"))) (setq str1 2048))
((and (/= 0 (logand osmode 4096)) (equal osp (osnap p "_app,"))) (setq str1 4096))
((and (/= 0 (logand osmode 8192)) (equal osp (osnap p "_par,"))) (setq str1 8192))
)
(redraw)
(cond (osp str1(setq p osp) (grbox osp str1)))
)
)
p
)
(defun grbox (pt str1 / h p1 p2 p3 p4)
(setq h (* (/ (getvar "viewsize") (cadr (getvar "screensize"))) (getvar "pickbox"))
p1 (mapcar '- pt (list h h 0.))
p2 (mapcar '+ pt (list h (- h) 0.))
p3 (mapcar '+ pt (list h h 0.))
p4 (mapcar '+ pt (list (- h) h 0.))
p5 (mapcar '- pt (list h 0 0.))
p6 (mapcar '- pt (list 0 h 0.))
p7 (mapcar '+ pt (list 0 h 0.))
p8 (mapcar '+ pt (list h 0. 0.))
p8a (mapcar '+ pt (list (1- h) 0. 0.))
$angis 0.20944
i 0
)
(cond ((= str1 1) (grvecs (list 1 p1 p2 1 p2 p3 1 p3 p4 1 p4 p1)))
((= str1 2) (grvecs (list 1 p7 p1 1 p7 p2 1 p1 p2)))
((= str1 4)
(repeat 30
(setq p9 (polar pt $angis h))
(grvecs (list 1 p8 p9))
(setq p8 p9
$angis (+ $angis 0.20944)
)
)
)
((= str1 8) (grvecs (list 1 p1 p2 1 p2 p3 1 p3 p4 1 p4 p1)))
((= str1 16)(grvecs (list 1 p5 p6 1 p6 p8 1 p8 p7 1 p7 p5)))
((= str1 32)(grvecs (list 1 p1 p3 1 p2 p4)))
((= str1 64)(grvecs (list 1 p1 p2 1 p2 p3 1 p3 p4 1 p4 p1)))
((= str1 128) (grvecs (list 1 p1 p2 1 p1 p4 1 pt p5 1 pt p6)))
((= str1 256)
(repeat 30
(setq p9 (polar pt $angis (1- h)))
(grdrawp8a p9 1)
(setq p8a p9
$angis (+ $angis 0.20944)
)
)
(grdraw p3 p4 1)
)
((= str1 512)(grvecs (list 1 p1 p2 1 p2 p4 1 p3 p4 1 p3 p1)))
((= str1 2048) (grvecs (list 1 p1 p2 1 p2 p3 1 p3 p4 1 p4 p1)))
((= str1 4096) (grvecs (list 1 p1 p2 1 p2 p3 1 p3 p4 1 p4 p1)))
((= str1 8192) (grvecs (list 1 p1 p2 1 p2 p3 1 p3 p4 1 p4 p1)))
)
)
学无止境,支持各位斑主一下