明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 2318|回复: 3

呵呵,关于pline的一个lsp,xd上的一个网做的.感觉挺好

[复制链接]
发表于 2003-5-8 10:13 | 显示全部楼层 |阅读模式
呵呵,关于pline的一个lsp,xd上的一个网做的.感觉挺好,大家一起看看.
(defun c:mq (/ Obj ObjX Pt PtX Dist Rtn New Ortho CEcho Osmode)
  (setq        Osmode (getvar "Osmode")
        Ortho  (getvar "OrthoMode")
        CEcho  (getvar "CmdEcho")
  )
  (setvar "CmdEcho" 0)
  (setvar "OrthoMode" 0)
  (if (setq Obj (nentsel "\n Pick (Lw)Polyline segment :"))
    (setq Pt  (cadr Obj)
          Obj (car Obj)
    )
  )
  (if (null (wcmatch (cdr (assoc 0 (entget Obj)))
                     "*POLYLINE"
            )
      )
    (alert "\n not a polyline, please re-call function!")
    (progn
      (command "_.Undo" "_Group")
      (command "_.Explode" Obj)
      (setq ObjX (car (nentselp Pt))
            Dist (getvar "OffsetDist")
      )
      (if (null
            (setq
              Dist (getdist
                     (strcat
                       "\n Enter offset distance [Minus for Through] <"
                       (rtos Dist 2 3)
                       ">:"
                     )
                   )
            )
          )
        (setq Dist (getvar "OffsetDist"))
      )
      (redraw ObjX 3)
      (princ "\n Pick offset direction :")
      (if (setq PtX (getpoint Pt))
        (progn
          (setvar "osmode" 0)
          (command "_.Offset"
                   (if (> Dist 0.0)
                     Dist
                     "_T"
                   )
                   (list ObjX Pt)
                   PtX
          )
          (while (/= (getvar "CmdNames") "")
            (command "")
          )
          (setq Rtn (cdr (entget (entlast))))
        )
      )
      (command "_.Undo" "_End")
      (command "_U")
      (if Rtn
        (entmake Rtn)
      )
    )
  )
  (if Osmode
    (setvar "osmode" Osmode)
  )
  (if Ortho
    (setvar "OrthoMode" Ortho)
  )
  (if CEcho
    (setvar "CmdEcho" CEcho)
  )
  (princ)
)

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2003-5-8 12:28 | 显示全部楼层

你走太快沒看到我的程序

本帖最后由 作者 于 2003-5-8 12:28:46 编辑

(defun C:PLINEOFFSET (/ HOLDECHO HOLDOSMODE 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 HOLDECHO (getvar "cmdecho"))
  (setvar "cmdecho" 0)
  (command "_.undo" "_group")
  (setq HOLDOSMODE (getvar "osmode"))
  (setvar "osmode" 0)
  (while (null ENT)
    (prompt "\n拾取POLYLINE要偏移的段: ")
    (setq ENT (ssget ":S" '((0 . "*POLYLINE"))))
  )
  (setq        ENT (list (ssname ENT 0)
                  (osnap (cadr (nth 3 (car (ssnamex ENT 0)))) "nea")
            )
  )
  (initget 1)
  (setq DIST (getdist (cadr ENT) "\n输入偏移距离:"))
  (initget 1)
  (setq PNT (getpoint (cadr ENT) "\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" HOLDOSMODE)
  (command "_.undo" "_end")
  (setvar "osmode" HOLDECHO)
  (princ)
)
发表于 2013-8-15 01:22 | 显示全部楼层
这个还不给个源码
 楼主| 发表于 2020-4-7 01:56 | 显示全部楼层
好久以前的了。现在看看还是简陋的很。Pline线这个东西。。。。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-5-10 04:36 , Processed in 0.133653 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表