多段线单段偏移

xiaolong1487 · 发表于 2014-9-21 11:52:34

本帖最后由 xiaolong1487 于 2014-9-21 20:35 编辑

引用http://bbs.mjtd.com/thread-6521-1-1.html 龙龙仔的源码
跟据个人需求，改了一下输入顺序，加了个循环！但是有个问题解决不了，想请教一下！

;;;多段线单边偏移
(defun l_offset (/ ce os ENT ENT1 ENT2 DIST PNT)
(defun SEGMENTPTS (ENT / PNT VOBJ PARAM1 PARAM2 P1 P2 SEGPTS)
(and
(setq VOBJ (vlax-ename->vla-object (car ENT)))
(setq PNT (trans (cadr ENT) 1 0))
(setq PNT (vlax-curve-getclosestpointto VOBJ PNT))
(setq PARAM1 (vlax-curve-getparamatpoint VOBJ PNT))
(setq PARAM1 (fix PARAM1))
(setq PARAM2 (1+ PARAM1))
(if (equal PARAM1 (vlax-curve-getstartparam VOBJ) 1e-10)
(setq P1 (vlax-curve-getstartpoint VOBJ))
(setq P1 (vlax-curve-getpointatparam VOBJ PARAM1))
)
(if (equal PARAM2 (vlax-curve-getendparam VOBJ) 1e-10)
(setq P2 (vlax-curve-getendpoint VOBJ))
(setq P2 (vlax-curve-getpointatparam VOBJ PARAM2))
)
P1
P2
(setq BULGE (vla-getbulge VOBJ PARAM1))
(setq SEGPTS (list P1 P2 BULGE))
)
SEGPTS
)
(defun CALCBULGE (ENT / ARCRAD CENDIR HLFANG)
(setq VX1 (nth 0 ENT)
VX2 (nth 1 ENT)
BLG (nth 2 ENT)
)
(setq HLFANG (* 2 (atan BLG))
CENDIR ((if (< BLG 0)
-
+
)
(- (angle VX1 VX2) HLFANG)
(/ pi 2)
)
ARCRAD (abs (/ (/ (distance VX1 VX2) 2.0) (sin HLFANG)))
)
(list
(polar VX1 CENDIR ARCRAD)
ARCRAD
(* (abs HLFANG) 2.0)
)
)
(setq ce (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "_.undo" "_group")
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq DIST (getreal "\n输入偏移距离<3>:"))
(if (= dist nil)
(setq dist 3)
)
(setq b 1)
(while (<= b 100)
(prompt "\n拾取POLYLINE要偏移的段: ")
(setq ENT (ssget ":S" '((0 . "*POLYLINE"))))
(if (not (null ENT))(progn
(setq ENT (list (ssname ENT 0)
(osnap (cadr (nth 3 (car (ssnamex ENT 0)))) "nea")
)
)
(setq PNT (getpoint "\n拾取方向:"))
(setq ENT1 (SEGMENTPTS ENT))
(if (/= (nth 2 ENT1) 0)
(setq ENT (CALCBULGE ENT1))
)
(if (/= (nth 2 ENT1) 0)
(if (> (nth 2 ENT1) 0)
(command "_.arc" "c" (nth 0 ENT) (nth 0 ENT1) (nth 1 ENT1))
(command "_.arc" "c" (nth 0 ENT) (nth 1 ENT1) (nth 0 ENT1))
)
(command "_.line" (nth 0 ENT1) (nth 1 ENT1) "")
)
(setq ENT2 (entlast))
(command "_.Offset" DIST ENT2 PNT "")
(entdel ENT2)
(setq b (1+ b)))
(setq b 101)))
(setvar "osmode" os)
(command "_.undo" "_end")
(setvar "cmdecho" ce)
(princ)
)
(defun c:of ()
(l_offset))

;;;多段线单边偏移 
(defun l_offset (/ ce os ENT ENT1 ENT2 DIST PNT) 
 
  (defun SEGMENTPTS (ENT / PNT VOBJ PARAM1 PARAM2 P1 P2 SEGPTS) 
    (and 
      (setq VOBJ (vlax-ename->vla-object (car ENT))) 
      (setq PNT (trans (cadr ENT) 1 0)) 
      (setq PNT (vlax-curve-getclosestpointto VOBJ PNT)) 
      (setq PARAM1 (vlax-curve-getparamatpoint VOBJ PNT)) 
      (setq PARAM1 (fix PARAM1)) 
      (setq PARAM2 (1+ PARAM1)) 
      (if (equal PARAM1 (vlax-curve-getstartparam VOBJ) 1e-10) 
        (setq P1 (vlax-curve-getstartpoint VOBJ)) 
        (setq P1 (vlax-curve-getpointatparam VOBJ PARAM1)) 
      ) 
      (if (equal PARAM2 (vlax-curve-getendparam VOBJ) 1e-10) 
        (setq P2 (vlax-curve-getendpoint VOBJ)) 
        (setq P2 (vlax-curve-getpointatparam VOBJ PARAM2)) 
      ) 
      P1 
      P2 
      (setq BULGE (vla-getbulge VOBJ PARAM1)) 
      (setq SEGPTS (list P1 P2 BULGE)) 
    ) 
    SEGPTS 
  ) 
 
  (defun CALCBULGE (ENT / ARCRAD CENDIR HLFANG) 
    (setq VX1 (nth 0 ENT) 
          VX2 (nth 1 ENT) 
          BLG (nth 2 ENT) 
    ) 
    (setq HLFANG (* 2 (atan BLG)) 
          CENDIR ((if (< BLG 0) 
                    - 
                    + 
                  ) 
                   (- (angle VX1 VX2) HLFANG) 
                   (/ pi 2) 
                 ) 
          ARCRAD (abs (/ (/ (distance VX1 VX2) 2.0) (sin HLFANG))) 
    ) 
    (list 
      (polar VX1 CENDIR ARCRAD) 
      ARCRAD 
      (* (abs HLFANG) 2.0) 
    ) 
  ) 
 
  (setq ce (getvar "cmdecho")) 
  (setvar "cmdecho" 0) 
  (command "_.undo" "_group") 
  (setq os (getvar "osmode")) 
  (setvar "osmode" 0) 
  (setq DIST (getreal  "\n输入偏移距离<3>:")) 
  (if (= dist nil) 
    (setq dist 3) 
    ) 
  (setq b 1) 
  (while (<= b 100) 
     (prompt "\n拾取POLYLINE要偏移的段: ") 
    (setq ENT (ssget ":S" '((0 . "*POLYLINE")))) 
     (if (not (null ENT))(progn 
  (setq   ENT (list (ssname ENT 0) 
                  (osnap (cadr (nth 3 (car (ssnamex ENT 0)))) "nea") 
            ) 
  ) 
  (setq PNT (getpoint "\n拾取方向:")) 
  (setq ENT1 (SEGMENTPTS ENT)) 
  (if (/= (nth 2 ENT1) 0) 
    (setq ENT (CALCBULGE ENT1)) 
  ) 
  (if (/= (nth 2 ENT1) 0) 
    (if        (> (nth 2 ENT1) 0) 
      (command "_.arc" "c" (nth 0 ENT) (nth 0 ENT1) (nth 1 ENT1)) 
      (command "_.arc" "c" (nth 0 ENT) (nth 1 ENT1) (nth 0 ENT1)) 
    ) 
    (command "_.line" (nth 0 ENT1) (nth 1 ENT1) "") 
  ) 
  (setq ENT2 (entlast)) 
  (command "_.Offset" DIST ENT2 PNT "") 
  (entdel ENT2) 
  (setq b (1+ b))) 
  (setq b 101))) 
  (setvar "osmode" os) 
  (command "_.undo" "_end") 
  (setvar "cmdecho" ce) 
  (princ) 
) 
(defun c:of () 
(l_offset))

跟据个人需求想简化命令，该怎么修改主程式！还想加个判断，先单线的复线都可运行！

(defun c:oo3()
(command "l_offset" "1")
)
(defun c:oo2()
(command "l_offset" "2")
)
(defun c:oo3()
(command "l_offset" "3")
)
(defun c:oo4()
(command "l_offset" "4")
)

xiaolong1487 · 发表于 2015-12-26 22:33:05

;;;多段线单边偏移
(defun l_offset (DIST / calcbulge ce ent ent1 ent2 os pnt segmentpts)
(defun SEGMENTPTS (ENT / bulge P1 P2 PARAM1 PARAM2 PNT SEGPTS VOBJ)
(and
(setq VOBJ (vlax-ename->vla-object (car ENT)))
(setq PNT (trans (cadr ENT) 1 0))
(setq PNT (vlax-curve-getclosestpointto VOBJ PNT))
(setq PARAM1 (vlax-curve-getparamatpoint VOBJ PNT))
(setq PARAM1 (fix PARAM1))
(setq PARAM2 (1+ PARAM1))
(if (equal PARAM1 (vlax-curve-getstartparam VOBJ) 1e-10)
(setq P1 (vlax-curve-getstartpoint VOBJ))
(setq P1 (vlax-curve-getpointatparam VOBJ PARAM1))
)
(if (equal PARAM2 (vlax-curve-getendparam VOBJ) 1e-10)
(setq P2 (vlax-curve-getendpoint VOBJ))
(setq P2 (vlax-curve-getpointatparam VOBJ PARAM2))
)
P1
P2
(setq BULGE (vla-getbulge VOBJ PARAM1))
(setq SEGPTS (list P1 P2 BULGE))
)
SEGPTS
);
(defun CALCBULGE (ENT / ARCRAD blg CENDIR HLFANG vx1 vx2)
(setq VX1 (nth 0 ENT)
VX2 (nth 1 ENT)
BLG (nth 2 ENT)
)
(setq HLFANG (* 2 (atan BLG))
CENDIR ((if (< BLG 0)
-
+
)
(- (angle VX1 VX2) HLFANG)
(/ pi 2)
)
ARCRAD (abs (/ (/ (distance VX1 VX2) 2.0) (sin HLFANG)))
)
(list
(polar VX1 CENDIR ARCRAD)
ARCRAD
(* (abs HLFANG) 2.0)
)
);
(setq ce (getvar "cmdecho")
os (getvar "osmode")
)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(prompt "\n拾取POLYLINE要偏移的段: ")
(while (setq ENT (ssget ":S" '((0 . "*POLYLINE"))))
(setq ENT (list (ssname ENT 0)
(osnap (cadr (nth 3 (car (ssnamex ENT 0)))) "nea")
)
)
(setq PNT (getpoint "\n拾取方向:"))
(setq ENT1 (SEGMENTPTS ENT))
(if (/= (nth 2 ENT1) 0)
(setq ENT (CALCBULGE ENT1))
)
(if (/= (nth 2 ENT1) 0)
(if (> (nth 2 ENT1) 0)
(command "_.arc" "c" (nth 0 ENT) (nth 0 ENT1) (nth 1 ENT1))
(command "_.arc" "c" (nth 0 ENT) (nth 1 ENT1) (nth 0 ENT1))
)
(command "_.line" (nth 0 ENT1) (nth 1 ENT1) "")
)
(setq ENT2 (entlast))
(command "_.Offset" DIST ENT2 PNT "")
(entdel ENT2)
)
(setvar "osmode" os)
(setvar "cmdecho" ce)
(princ)
)
(defun c:oo1()
(l_offset 1)
)
(defun c:oo2()
(l_offset 2)
)
(defun c:oo3()
(l_offset 3)
)
(defun c:oo4()
(l_offset 4)
)

;;;多段线单边偏移 
(defun l_offset (DIST / calcbulge ce ent ent1 ent2 os pnt segmentpts) 
  (defun SEGMENTPTS (ENT / bulge P1 P2 PARAM1 PARAM2 PNT SEGPTS VOBJ) 
    (and 
      (setq VOBJ (vlax-ename->vla-object (car ENT))) 
      (setq PNT (trans (cadr ENT) 1 0)) 
      (setq PNT (vlax-curve-getclosestpointto VOBJ PNT)) 
      (setq PARAM1 (vlax-curve-getparamatpoint VOBJ PNT)) 
      (setq PARAM1 (fix PARAM1)) 
      (setq PARAM2 (1+ PARAM1)) 
      (if (equal PARAM1 (vlax-curve-getstartparam VOBJ) 1e-10) 
        (setq P1 (vlax-curve-getstartpoint VOBJ)) 
        (setq P1 (vlax-curve-getpointatparam VOBJ PARAM1)) 
      ) 
      (if (equal PARAM2 (vlax-curve-getendparam VOBJ) 1e-10) 
        (setq P2 (vlax-curve-getendpoint VOBJ)) 
        (setq P2 (vlax-curve-getpointatparam VOBJ PARAM2)) 
      ) 
      P1 
      P2 
      (setq BULGE (vla-getbulge VOBJ PARAM1)) 
      (setq SEGPTS (list P1 P2 BULGE)) 
    ) 
    SEGPTS 
  ); 
   
  (defun CALCBULGE (ENT / ARCRAD blg CENDIR HLFANG vx1 vx2) 
    (setq VX1 (nth 0 ENT) 
      VX2 (nth 1 ENT) 
      BLG (nth 2 ENT) 
    ) 
    (setq HLFANG (* 2 (atan BLG)) 
      CENDIR ((if (< BLG 0) 
                - 
                + 
              ) 
               (- (angle VX1 VX2) HLFANG) 
               (/ pi 2) 
             ) 
      ARCRAD (abs (/ (/ (distance VX1 VX2) 2.0) (sin HLFANG))) 
    ) 
    (list 
      (polar VX1 CENDIR ARCRAD) 
      ARCRAD 
      (* (abs HLFANG) 2.0) 
    ) 
  ); 
   
  (setq ce (getvar "cmdecho") 
    os (getvar "osmode") 
  ) 
  (setvar "cmdecho" 0) 
  (setvar "osmode" 0) 
  (prompt "\n拾取POLYLINE要偏移的段: ") 
  (while (setq ENT (ssget ":S" '((0 . "*POLYLINE")))) 
    (setq   ENT (list (ssname ENT 0) 
                  (osnap (cadr (nth 3 (car (ssnamex ENT 0)))) "nea") 
                ) 
    ) 
    (setq PNT (getpoint "\n拾取方向:")) 
    (setq ENT1 (SEGMENTPTS ENT)) 
    (if (/= (nth 2 ENT1) 0) 
      (setq ENT (CALCBULGE ENT1)) 
    ) 
    (if (/= (nth 2 ENT1) 0) 
      (if  (> (nth 2 ENT1) 0) 
        (command "_.arc" "c" (nth 0 ENT) (nth 0 ENT1) (nth 1 ENT1)) 
        (command "_.arc" "c" (nth 0 ENT) (nth 1 ENT1) (nth 0 ENT1)) 
      ) 
      (command "_.line" (nth 0 ENT1) (nth 1 ENT1) "") 
    ) 
    (setq ENT2 (entlast)) 
    (command "_.Offset" DIST ENT2 PNT "") 
    (entdel ENT2) 
    
  ) 
  (setvar "osmode" os) 
  (setvar "cmdecho" ce) 
  (princ) 
) 
 
 
(defun c:oo1() 
  (l_offset 1) 
) 
(defun c:oo2() 
  (l_offset 2) 
) 
(defun c:oo3() 
  (l_offset 3) 
) 
(defun c:oo4() 
  (l_offset 4) 
)

xyp1964 · 发表于 2014-9-22 07:22:30

xiaolong1487 · 发表于 2014-9-22 08:29:07

xyp1964 发表于 2014-9-22 07:22

谢谢版主，可是这个不是我想要的！还有，您老大的工具必须要加载XCAD，能不能单独做的函数包啊！

知行ooo李肖坪 · 发表于 2015-12-27 07:12:50

同步学习中……………………

vladimirputin · 发表于 2023-2-12 14:37:39

非常棒的代码，谢谢楼主分享啊。

vladimirputin · 发表于 2023-2-12 14:39:04

非常棒的代码，谢谢楼主分享啊。

xzd716 · 发表于 2023-3-12 16:08:29

急需的学习参考资料，谢谢楼主分享！

zmzk · 发表于 2023-11-30 22:00:25

测试了下，还是不完美，这个程序只对多义线起作用，对直线就失效了！

账号		自动登录	找回密码
密码			注册

[已解答] 多段线单段偏移

本帖子中包含更多资源