多段线单边拉伸程序的问题

cj52000

各位好，在论坛上找了个多段线单边拉伸的程序，试用后提示“错误: no function definition: WHNTGDM”，现把源码发上来，大家帮我看看啊，谢谢！

;;;程序名称：多义线单边拉伸程序
(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)        ;还原捕捉
)

mandala

缺了个子程序(whntgdm)，不知道是派什么用场的。将程序开始时的(whntgdm)删掉即可运行，只是不知道是否就是你要的结果。试一下吧。

mandala

这个程序编的乱哄哄的。另外好像圆弧段不能拉伸。

lichunyu

没看明白啊

yxl88168

回复 mandala 的帖子

谢谢楼主，这个真不错

paulpipi

孙玉坤

好像不能用