双线内或外偏移

pop159

这个是论坛里某位前辈的双线内偏移的程序，不知道可否改成外偏移也可以呢。好像要达到可以外偏移似乎有些难度哦，请各位帮忙看看或提些思路啊，谢谢啦 另外可以改成框选（多选）吗
(defun C:PX (/ a dist dist1 ent1 ent2 name1 name2 pt1 pt2 pt3 pt4)
  (setvar "cmdecho" 0)         ; 关闭命令响应
  (setq $orr *error*)
  (setq *error* #err2)         ; 当程序出错时就会执行#err函数
  (command ".UNDO" "BE")        ; 设置UNDO起点
  (setq t 1)
  (while (= t 1)
    (if (setq name1 (car (entsel "\n选择第一条直线：")))
      (progn
(setq ent1 (entget name1))
(if (= (cdr (assoc 0 ent1)) "LINE")
   (progn
     (setq PT1 (cdr (assoc 10 ent1)))
     (setq PT2 (cdr (assoc 11 ent1)))
     (redraw name1 3)
     (setq t 2)
   )
)
      )
    )
  )
  (while (= t 2)
    (if (setq name2 (car (entsel "\n选择第二条直线：")))
      (progn
(setq ent2 (entget name2))
(if (= (cdr (assoc 0 ent2)) "LINE")
   (progn
     (setq PT3 (cdr (assoc 10 ent2)))
     (setq PT4 (cdr (assoc 11 ent2)))
     (if (= (distance PT1 (vlax-curve-getclosestpointto name2 PT1 t)) (distance PT3 (vlax-curve-getclosestpointto name1 PT3 t)))
       (progn
  (setq dist (distance PT1 (vlax-curve-getclosestpointto name2 PT1 t)))
  (redraw name2 3)
  (setq t 3)
       )
       (princ "\n选择的直线不平行，重新选择第二条直线：")
     )
   )
)
      )
    )
  )
  (while (= t 3)
    (if (= chanshu001 nil)
      (setq chanshu001 100.0)
    )
    (setq dist1 (getreal (strcat "\n输入新的平行线距离(应 <" (rtos dist 2) " ) <" (rtos chanshu001 2) ">:")))
    (cond
      ((null dist1)
(setq dist1 chanshu001)
      )
      ((= dist1 0.0)
(setq dist1 chanshu001)
      )
      (t
(setq chanshu001 dist1)
      )
    )
    (if (< dist1 dist)
      (progn
(setq a (/ (- dist dist1) 2))
(command "OFFSET" a name1 PT3 name2 PT1 "")
(setq t 4)
      )
      (princ "\n距离超过原平行线，请重新输入新的平行线距离：")
    )
  )
  (redraw name1 4)
  (redraw name2 4)
  (command ".UNDO" "E")         ; 设置UNDO终点
  (setq *error* $orr)
  (princ)
)
;;; 出错处理函数
(defun #err2 (s)
  (command ".UNDO" "E")         ; 设置UNDO终点
  (redraw name1 4)
  (redraw name2 4)
  (princ)
  (setq *error* $orr)
)


原贴的位置：http://bbs.mjtd.com/forum.php?mo ... AB%D2%C6&page=1

pop159

平行的双线同时外侧偏移，找“点”没思路呀，因为每条直线的终起点都会影响的，还有角度等，请教请教

evayleung

用polar自己构造一个点出来嘛。

ssyfeng

试试这个：

2. (defun c:tt (/ ang1 ang2 en1 en2 getds nwcs p2 perpt pts1 pts2 qpt qxcs r0 tang)
   
3.   (vl-load-com)
   
4.   (setq en1 (car (entsel "\n选择第一根平行直线："))
   
5.     en2 (car (entsel "\n选择第二根平行直线："))
   
6.     nwcs (if (null (setq nwcs (getint "\n选择偏移方向 < 1向内，2向外 > [默认：向外]："))) 2 nwcs)
   
7.     pts1 (list (cdr (assoc 10 (entget en1))) (cdr (assoc 11 (entget en1))))
   
8.     pts2 (list (cdr (assoc 10 (entget en2))) (cdr (assoc 11 (entget en2))))
   
9.     ang1 (angle (car pts1) (cadr pts1))
   
10.     ang2 (angle (car pts2) (cadr pts2))
    
11.     getds (if (null (setq getds (getreal "\n输入偏移距离[默认：20]："))) 20 getds)
    
12.     perPT (vlax-curve-getclosestpointto en1 (car pts2))
    
13.     qxcs (vlax-curve-getparamatpoint en1 perPT)
    
14.     qpt (vlax-curve-getFirstDeriv en1 qxcs)
    
15.     TAng (angle '(0.0 0.0 0.0) qpt)
    
16.     p2 (vlax-curve-getclosestpointto en1 (car pts2))
    
17.     r0 (- (angle p2 (car pts2)) TAng)
    
18.     r0 (if (< r0 0)
    
19.          (+ r0 (* pi 2))
    
20.          r0
    
21.        )
    
22.   )
    
23.   (cond ((equal nwcs 1) (setq getds (* getds -1))))
    
24.   (if (equal ang1 ang2 0.001)
    
25.     (if (<= 0 r0 pi)
    
26.       (progn
    
27.         (vla-offset (vlax-ename->vla-object en2) getds)
    
28.         (vla-offset (vlax-ename->vla-object en1) (* getds -1))
    
29.       )
    
30.       (progn
    
31.         (vla-offset (vlax-ename->vla-object en1) getds)
    
32.         (vla-offset (vlax-ename->vla-object en2) (* getds -1))
    
33.       )
    
34.     )
    
35.     (if (<= 0 r0 pi)
    
36.       (progn
    
37.         (vla-offset (vlax-ename->vla-object en1) (* getds -1))
    
38.         (vla-offset (vlax-ename->vla-object en2) (* getds -1))
    
39.       )
    
40.       (progn
    
41.         (vla-offset (vlax-ename->vla-object en2) getds)
    
42.         (vla-offset (vlax-ename->vla-object en1) getds)
    
43.       )
    
44.     )
    
45.   )
    
46.   (princ)
    
47. )

(defun c:tt (/ ang1 ang2 en1 en2 getds nwcs p2 perpt pts1 pts2 qpt qxcs r0 tang)<br />   (vl-load-com)<br />   (setq en1 (car (entsel "\n选择第一根平行直线："))<br />     en2 (car (entsel "\n选择第二根平行直线："))<br />     nwcs (if (null (setq nwcs (getint "\n选择偏移方向 < 1向内，2向外 > [默认：向外]："))) 2 nwcs)<br />     pts1 (list (cdr (assoc 10 (entget en1))) (cdr (assoc 11 (entget en1))))<br />     pts2 (list (cdr (assoc 10 (entget en2))) (cdr (assoc 11 (entget en2))))<br />     ang1 (angle (car pts1) (cadr pts1))<br />     ang2 (angle (car pts2) (cadr pts2))<br />     getds (if (null (setq getds (getreal "\n输入偏移距离[默认：20]："))) 20 getds)<br />     perPT (vlax-curve-getclosestpointto en1 (car pts2))<br />     qxcs (vlax-curve-getparamatpoint en1 perPT)<br />     qpt (vlax-curve-getFirstDeriv en1 qxcs)<br />     TAng (angle '(0.0 0.0 0.0) qpt) <br />     p2 (vlax-curve-getclosestpointto en1 (car pts2))<br />     r0 (- (angle p2 (car pts2)) TAng)<br />     r0 (if (< r0 0)<br />          (+ r0 (* pi 2))<br />          r0<br />        )<br />   )<br />   (cond ((equal nwcs 1) (setq getds (* getds -1))))<br />   (if (equal ang1 ang2 0.001)<br />     (if (<= 0 r0 pi)<br />       (progn <br />         (vla-offset (vlax-ename->vla-object en2) getds)<br />         (vla-offset (vlax-ename->vla-object en1) (* getds -1))<br />       )<br />       (progn <br />         (vla-offset (vlax-ename->vla-object en1) getds)<br />         (vla-offset (vlax-ename->vla-object en2) (* getds -1))<br />       )<br />     )<br />     (if (<= 0 r0 pi)<br />       (progn <br />         (vla-offset (vlax-ename->vla-object en1) (* getds -1))<br />         (vla-offset (vlax-ename->vla-object en2) (* getds -1))<br />       )<br />       (progn <br />         (vla-offset (vlax-ename->vla-object en2) getds)<br />         (vla-offset (vlax-ename->vla-object en1) getds)<br />       )<br />     )<br />   )<br />   (princ)<br /> )

pop159

ssyfeng 发表于 2019-1-1 14:09
试试这个：

谢谢啦，经过测试，对斜线的内外判断会出错，就是这点不知道如何解决呢，其他的自己可以修改的。希望完善下。拜托了

pop159

好像找到原因了，似乎是 nwcs 这个变量有时候一直是 1 ，即使输入2 的时候。还在测试... ... ，再次感谢

ssyfeng

重新修改了一下代码，你试试上面更新后的代码看看。

pop159

可以了，，谢谢

zmzk

已下载，好方法，好思路