高手帮忙修改，批量偏移

dforme · 发表于 2012-3-20 13:54

本帖最后由 dforme 于 2013-3-5 17:49 编辑

在本论坛找到一个可内外偏移的Lisp程序，但是只能对单一对象操作，我想同时对若干个对象进行偏移，框选或者是加选区，请高手帮忙修改一下。不胜感激

;;用LISP实现将PL环向内或向外偏移
;;http://www.mjtd.com/Develop/ArticleShow.asp?ArticleID=654
(defun C:TEE (/ HOLDOSMODE HOLDCMD WW ENT PT PT1 PT2 CURVE X JANG DIST)
(defun LEN (CURVE)
(setq TLEN (vlax-curve-getdistatparam
CURVE
(vlax-curve-getendparam CURVE)
)
)
)
(setq HOLDOSMODE (getvar "OSMODE"))
(setq HOLDCMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setvar "OSMODE" 0)
(setq WW (entsel "\n选取偏移对象: "))
(setq ENT (car WW))
(setq PT (cadr WW))
(setq CURVE (vlax-ename->vla-object ENT))
(setq X (vlax-curve-getparamatpoint
CURVE
(setq PT (vlax-curve-getclosestpointto
CURVE
PT
)
)
)
)
(setq JANG (angle '(0 0 0) (vlax-curve-getfirstderiv CURVE X)))
(setq PT1 (polar PT (+ JANG (* 0.5 pi)) 0.00000001))
(setq PT2 (polar PT (- JANG (* 0.5 pi)) 0.00000001))
(initget 3)
(setq DIST (getdist "\n指定偏移距离<正__向外偏移 /负__向内偏移>: "))
(command "_.OFFSET" (abs DIST) ENT PT1 "")
(cond
((and (> DIST 0) (> (LEN CURVE) (LEN (entlast))))
(entdel (entlast))
(command "_.OFFSET" DIST ENT PT2 "")
)
((and (< DIST 0) (< (LEN CURVE) (LEN (entlast))))
(entdel (entlast))
(command "_.OFFSET" (abs DIST) ENT PT2 "")
)
)
(setvar "OSMODE" HOLDOSMODE)
(setvar "CMDECHO" HOLDCMD)
(princ)
)

;;用LISP实现将PL环向内或向外偏移 
;;http://www.mjtd.com/Develop/ArticleShow.asp?ArticleID=654 
(defun C:TEE (/ HOLDOSMODE HOLDCMD WW ENT PT PT1 PT2 CURVE X JANG DIST) 
(defun LEN (CURVE) 
(setq TLEN (vlax-curve-getdistatparam 
CURVE 
(vlax-curve-getendparam CURVE) 
) 
) 
) 
(setq HOLDOSMODE (getvar "OSMODE")) 
(setq HOLDCMD (getvar "CMDECHO")) 
(setvar "CMDECHO" 0) 
(setvar "OSMODE" 0) 
(setq WW (entsel "\n选取偏移对象: ")) 
(setq ENT (car WW)) 
(setq PT (cadr WW)) 
(setq CURVE (vlax-ename->vla-object ENT)) 
(setq X (vlax-curve-getparamatpoint 
CURVE 
(setq PT (vlax-curve-getclosestpointto 
CURVE 
PT 
) 
) 
) 
) 
(setq JANG (angle '(0 0 0) (vlax-curve-getfirstderiv CURVE X))) 
(setq PT1 (polar PT (+ JANG (* 0.5 pi)) 0.00000001)) 
(setq PT2 (polar PT (- JANG (* 0.5 pi)) 0.00000001)) 
(initget 3) 
(setq DIST (getdist "\n指定偏移距离<正__向外偏移 /负__向内偏移>: ")) 
(command "_.OFFSET" (abs DIST) ENT PT1 "") 
(cond 
((and (> DIST 0) (> (LEN CURVE) (LEN (entlast)))) 
(entdel (entlast)) 
(command "_.OFFSET" DIST ENT PT2 "") 
) 
((and (< DIST 0) (< (LEN CURVE) (LEN (entlast)))) 
(entdel (entlast)) 
(command "_.OFFSET" (abs DIST) ENT PT2 "") 
) 
) 
(setvar "OSMODE" HOLDOSMODE) 
(setvar "CMDECHO" HOLDCMD) 
(princ) 
)

hb198075 · 发表于 2012-3-20 15:23

;;用LISP实现将PL环向内或向外偏移
;;http://www.mjtd.com/Develop/ArticleShow.asp?ArticleID=654
(defun C:TEE ( / curve ent holdcmd holdosmode jang n pt pt1 pt2 ss tmp x)
(defun LEN (CURVE / TLEN)
(setq TLEN (vlax-curve-getdistatparam
CURVE
(vlax-curve-getendparam CURVE)
)
)
)
(command "_.UNDO" "BE")
(if (null tee_dist)
(setq tee_dist 1000.0)
) ;_设置全局变量
(setq HOLDOSMODE (getvar "OSMODE"))
(setq HOLDCMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setvar "OSMODE" 0)
(if (setq ss (ssget '((0 . "*LINE,CIRCLE,ARC"))))
(progn
(setq n 0)
(initget 2)
(if (setq tmp
(getdist
(strcat "\n指定偏移距离(正__向外偏移 /负__向内偏移): <"
(rtos tee_dist 2)
">"
)
)
)
(setq tee_dist tmp)
) ;_不输入时自动使用上一次输入数值
(repeat (sslength ss)
(setq ent (ssname ss n)
n (1+ n)
)
(setq CURVE (vlax-ename->vla-object ENT)
x (vlax-curve-getParamAtDist curve (/ (len curve) 3.33))
pt (vlax-curve-getPointAtParam curve x)
);_获得线上指定距离值的点及参数
(setq JANG (angle '(0 0 0) (vlax-curve-getfirstderiv CURVE X)))
(setq PT1 (polar PT (+ JANG (* 0.5 pi)) 0.00000001))
(setq PT2 (polar PT (- JANG (* 0.5 pi)) 0.00000001))
(command "_.OFFSET" (abs tee_dist) ENT PT1 "")
(if (or (and (> tee_dist 0) (> (LEN CURVE) (LEN (entlast))))
(and (< tee_dist 0) (< (LEN CURVE) (LEN (entlast))))
)
(progn
(entdel (entlast))
(command "_.OFFSET" (abs tee_dist) ENT PT2 "")
)
)
)
)
)
(setvar "OSMODE" HOLDOSMODE)
(setvar "CMDECHO" HOLDCMD)
(command "_.UNDO" "E")
(princ)
)

;;用LISP实现将PL环向内或向外偏移 
;;http://www.mjtd.com/Develop/ArticleShow.asp?ArticleID=654 
(defun C:TEE ( / curve ent holdcmd holdosmode jang n pt pt1 pt2 ss tmp x) 
  (defun LEN (CURVE / TLEN) 
    (setq TLEN (vlax-curve-getdistatparam 
   CURVE 
   (vlax-curve-getendparam CURVE) 
        ) 
    ) 
  ) 
  (command "_.UNDO" "BE") 
  (if (null tee_dist) 
    (setq tee_dist 1000.0) 
  ) ;_设置全局变量 
  (setq HOLDOSMODE (getvar "OSMODE")) 
  (setq HOLDCMD (getvar "CMDECHO")) 
  (setvar "CMDECHO" 0) 
  (setvar "OSMODE" 0) 
  (if (setq ss (ssget '((0 . "*LINE,CIRCLE,ARC")))) 
    (progn 
      (setq n 0) 
      (initget 2) 
      (if (setq tmp 
   (getdist 
     (strcat "\n指定偏移距离(正__向外偏移 /负__向内偏移): <" 
      (rtos tee_dist 2) 
      ">" 
     ) 
   ) 
   ) 
 (setq tee_dist tmp) 
      ) ;_不输入时自动使用上一次输入数值 
      (repeat (sslength ss) 
 (setq ent (ssname ss n) 
       n   (1+ n) 
 ) 
 (setq CURVE (vlax-ename->vla-object ENT) 
       x     (vlax-curve-getParamAtDist curve (/ (len curve) 3.33)) 
       pt    (vlax-curve-getPointAtParam curve x) 
 );_获得线上指定距离值的点及参数 
 (setq JANG (angle '(0 0 0) (vlax-curve-getfirstderiv CURVE X))) 
 (setq PT1 (polar PT (+ JANG (* 0.5 pi)) 0.00000001)) 
 (setq PT2 (polar PT (- JANG (* 0.5 pi)) 0.00000001)) 
 (command "_.OFFSET" (abs tee_dist) ENT PT1 "") 
 (if (or (and (> tee_dist 0) (> (LEN CURVE) (LEN (entlast)))) 
  (and (< tee_dist 0) (< (LEN CURVE) (LEN (entlast)))) 
     ) 
   (progn 
     (entdel (entlast)) 
     (command "_.OFFSET" (abs tee_dist) ENT PT2 "") 
   ) 
 ) 
      ) 
    ) 
  ) 
  (setvar "OSMODE" HOLDOSMODE) 
  (setvar "CMDECHO" HOLDCMD) 
  (command "_.UNDO" "E") 
  (princ) 
)

dforme · 发表于 2012-3-20 17:33

hb198075 发表于 2012-3-20 15:23

十分感谢，您帮我解决了一个大问题

429014673 · 发表于 2012-3-20 21:18

hb198075 发表于 2012-3-20 15:23

偏移到当前层，如何改呀。。。

hb198075 · 发表于 2012-3-21 10:01

在 repeat 的前面加上下面这句就能偏移到当前层了，或者手工在 offset 命令中输入L来改变偏移的图层模式。

(command "_.OFFSET" "L" "C" "" "")

缘份呐 · 发表于 2012-4-10 18:43

学习学习，

vlisp2012 · 发表于 2012-4-10 19:14

很好的程序，对于下面材时减去料缝很有帮助。

shang_123 · 发表于 2012-4-10 20:03

很不错拿走了

雨的节奏 · 发表于 2012-4-11 16:51

好东西、、新手路过学习

xingyun300 · 发表于 2012-4-18 16:13

好像贱人工具箱里有这个功能，还是框选的！

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

[基础] 高手帮忙修改，批量偏移

点评

浏览过的版块