多段线单段偏移

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 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)
)

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

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

xyp1964 发表于 2014-9-22 07:22 static/image/common/back.gif

谢谢版主，可是这个不是我想要的！还有，您老大的工具必须要加载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

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

页: [1]

明经CAD社区's Archiver

多段线单段偏移