求各位高手帮助，一个多义线单边拉伸程序

xufulai

在其他论坛下载了个LISP程序，怎么在2010上面不能使用呢

 

;;;程序名称：多义线单边拉伸程序
(defun c:wj(/ pta3 ptb3 pt2n pt2nb i0)(whntgdm)
(setq oldos (getvar "osmode")) ;保存捕捉特性给oldos 
  (setvar "cmdecho" 0)
  (setvar "osmode" 247)
  (command "undo" "be")
  (if(= dis nil)
    (while(not(setq dis (getreal "\n请输入拉伸距离:"))))
    (setq dis (getreal (strcat "\n请输入拉伸距离:<" (rtos dis 2) ">")))
  )
  (if(= dis nil)(setq dis disold)(setq disold dis))
 
  (while(setq s1 (entsel "\n请指定拉伸的边:"))
    (setq pta3 nil ptb3 nil pt2n nil pt2nb nil i0 nil)
  (setq enlst (entget(car s1)))
  (setq pt_lst'())
  (if(= (cdr(assoc 0 enlst)) "LWPOLYLINE")
    (progn
      (setq p1 (cadr s1))
      (command "circle" p1 1)
      (setq p1 (cdr(assoc 10 (entget(entlast)))))
      (entdel (entlast))
      (setvar "osmode" 0)
      (terpri)(while(not(setq ps1 (getpoint "\n请指定拉伸方向:"))))
      (setvar "osmode" 247)
      (foreach i enlst (if(or(= (car i) 10)(= (car i) 42))(setq pt_lst (cons (cdr i) pt_lst))))
      (setq pt_lst (reverse pt_lst))
      (setq i 0)
      (while (setq p0 (nth i pt_lst))
(setq p2 (nth (+ i 2) pt_lst))
(if(= p2 nil)(setq p2 (nth 0 pt_lst) i0 -2)(setq i0 i))
(setq ang1a (angle p0 p1))
(setq ang2a (angle p1 p2))
(if(or(equal ang1a ang2a 0.001)(equal (+ pi pi ang1a) ang2a 0.001)(equal (+ pi pi ang2a) ang1a 0.001))
   (progn
     (setq pta1 p0 ptb1 p2)    
     (command "area" "o" (car s1))
     (setq are1 (getvar "Perimeter"))
     (command "offset" "t" s1 ps1 "")
     (setq ssx1 (entlast))
     (command "area" "o" ssx1)
            (setq are2 (getvar "Perimeter"))
     (entdel ssx1)
     (if(> are2 are1)(setq ffxx "1")(setq ffxx "0"))
     (if(<(- i 1)0)(setq tdza (nth (+(- i 1)(length pt_lst))pt_lst))
       (setq tdza (nth (- i 1) pt_lst)))
      (if(<(- i 2)0)(setq pta2 (nth (+(- i 2)(length pt_lst))pt_lst))
       (setq pta2 (nth (- i 2) pt_lst)))
     (if(or(/= tdza 0)(and(= tdza 0)(<= (distance pta2 pta1) (* 2 (sqrt 2)))))
       (progn
  (if(<(- i 3)0)(setq tdza1 (nth (+(- i 3)(length pt_lst))pt_lst))
    (setq tdza1 (nth (- i 3) pt_lst)))
  (if(= tdza1 0)
    (progn
      (if(<(- i 4)0)(setq pta3 (nth (+(- i 4)(length pt_lst))pt_lst))
        (setq pta3 (nth (- i 4) pt_lst)))
      (setq angla (angle pta3 pta2))
    )
  )
       )
       (setq angla (angle pta2 pta1))
     )
    
     (if(<(+ i0 3)(length pt_lst))
       (setq tdzb (nth (+ i0 3) pt_lst))
       (setq tdzb (nth (-(+ i0 3)(length pt_lst)) pt_lst))
     )
     (if(<(+ i0 4)(length pt_lst))
       (setq ptb2 (nth (+ i0 4) pt_lst))
       (setq ptb2 (nth (-(+ i0 4)(length pt_lst)) pt_lst))
     )
     (if(or(/= tdzb 0)(and(= tdzb 0)(<= (distance ptb2 ptb1) (* 2 (sqrt 2)))))
       (progn
  (if(<(+ i0 5)(length pt_lst))
    (setq tdzb1 (nth (+ i0 5) pt_lst))
    (setq tdzb1 (nth (-(+ i0 5)(length pt_lst)) pt_lst))
  )
  (if(= tdzb1 0)
    (progn    
      (if(<(+ i0 6)(length pt_lst))
        (setq ptb3 (nth (+ i0 6) pt_lst))
        (setq ptb3 (nth (-(+ i0 6)(length pt_lst)) pt_lst))
      )
      (setq anglb (angle ptb3 ptb2))
    )
  )
       )
       (setq anglb (angle ptb2 ptb1))
     )
     (setq anga1 (angle pta1 ptb1))
     (setq angb1 (angle ptb1 pta1))
     (if(equal anga1 (* 2 pi) 0.0001)(setq anga1 0))
     (if(equal angb1 (* 2 pi) 0.0001)(setq angb1 0))
     (setq anga2 (+ pi angla) angb2 (+ pi anglb))
     (if(>= anga2(* 2 pi))(setq anga2(- anga2 pi pi)))
     (if(>= angb2(* 2 pi))(setq angb2(- angb2 pi pi)))
    
     (if(> anga2 anga1)(setq anga3(- anga2 anga1))(setq anga3(- anga1 anga2)))
     (if(> angb2 angb1)(setq angb3(- angb2 angb1))(setq angb3(- angb1 angb2)))
     (setq disna (/ dis (abs(sin anga3))))
     (setq disnb (/ dis (abs(sin angb3))))
     (if(= ffxx "1")(setq pt1n (polar pta1 angla disna))(setq pt1n (polar pta1 (+ pi angla) disna)))
     (if(= ffxx "1")(setq pt1nb(polar ptb1 anglb disnb))(setq pt1nb(polar ptb1 (+ pi anglb) disnb)))
     (if(/= pta3 nil)(if(= ffxx "1")(setq pt2n (polar pta2 angla disna))(setq pt2n (polar pta2 (+ pi angla) disna))))
     (if(/= ptb3 nil)(if(= ffxx "1")(setq pt2nb(polar ptb2 anglb disnb))(setq pt2nb(polar ptb2 (+ pi anglb) disnb))))
     (setq i (length pt_lst))
          )
)
(setq i (+ 2 i))
      )
      (setq e (car s1))
      (setq m (entget e))
      (setq m (subst (cons 10 pt1n)(cons 10 pta1)m))
      (entmod m)
      (setq m (subst (cons 10 pt1nb)(cons 10 ptb1)m))
      (entmod m)
      (entupd e)
      (if(/= pt2n nil)
(progn
   (setq m (subst (cons 10 pt2n)(cons 10 pta2)m))
   (entmod m)
          (entupd e)
)
      )
      (if(/= pt2nb nil)
(progn
   (setq m (subst (cons 10 pt2nb)(cons 10 ptb2)m))
   (entmod m)
          (entupd e)
)
      )
    )
    (prompt "\n<您选择的线不是多义线,请串接成多义线再运行此程序!!!>")
  )
  )
  (command "undo" "e")
(setvar "osmode" oldos)        ;还原捕捉
)

lsjj

(whntgdm)

少了這個副程式

xufulai

楼上老大，我不会Lsp，怎么搞才可以用，

xufulai

你QQ多少啊

孙玉坤

黑色钢琴 发表于 2010-6-30 10:20
**** 作者被禁止或删除 内容自动屏蔽 ****

你好 你的修改好了吗