改单选单向动态延伸为多选双向动态延伸(已完美解决，多谢 ljpnb大师的热情帮助)

simon8001

回复 669423907 的帖子

哎呦我的娘啊，上岁数了眼睛就花了！！
先下班回去看！

ljpnb

simon8001 发表于 2011-7-5 16:21
各位兄弟 俺刚才试用了一下这个程序，如果两条直线不是互相垂直的情况，拉伸线交点就会不断的变化了，不知道 ...

那交点的问题处理一下就可以了，13楼已修改，支持不垂直的交线。。。。

669423907

回复 ljpnb 的帖子

大师真是精益求精啊！

669423907

回复 ljpnb 的帖子

大师是否方便帮看看 “色选+动态修改线型比例” 的程序呢？

maiko

好东东,顶顶

longer1000

myjping

带捕捉的
(defun c:tes (/ distance1 PT dxf1 OBJ angle1 my)
  (vl-load-com)
  (setvar "CMDECHO" 0)
  (setq  my 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")(setq  my 0))
  )
  (setq  my 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))
    )
   
    (setq  angle1 (angle p11 p12))
    (setq  distance1 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 (cos  myangle))
    (setq  distance1 (* cos1 (distance ptold pt)))
   
   
;    (if (> (/ pi 2) myangle) (setq  distance1 (distance ptold pt)) (setq  distance1 (-(distance ptold pt))))
;    (setq  distance1 (* distance1 (abs(cos myangle ))))
    (setq  p14 (polar p12   angle1  distance1 ))
    (setq dxf1 (subst (cons 11 p14) (assoc 11 dxf1) dxf1))
    (entmod dxf1)
    )
   
    (progn
    (setq myangle2 (angle p12 p11) )
    (setq myangle (- myangle1 myangle2))
    (setq cos1 (cos  myangle))
    (setq  distance1 (* cos1 (distance ptold pt)))
   
    ;(if(> myangle (* 1.5 pi) )(setq myangle (- myangle (* 1.5 pi)) ))
   
   
;    (if (> (/ pi 2) myangle) (setq  distance1 (distance ptold pt)) (setq  distance1 (-(distance ptold pt))))
;    (setq  distance1 (* distance1 (abs(cos myangle ))))
    (setq  p13 (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)(setq  my 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)))
            (grdraw  p8a 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)))
  )
)

AMTONNY

学无止境,支持各位斑主一下

黑洞—杜明智