xiao88gang 发表于 2016-10-4 17:01:57

大家帮我看看这个源码,为什么只对直线起作用,圆和圆弧怎么用不了。

这是一个变双线的代码,默认是0.3,当宽度大于0.7时,两头会自己封口。可是有个弊端,就是只对直线起作用,圆和圆弧怎么用不了。哪位高手能帮忙改一下,使圆和圆弧都能用。在这里先谢谢了。
(defun c:dkK (/ esel ename entna s st1 st2 ed1 ed2)
(setq temperr *error*)
(setq *error* trap8)
(setq old1 (getvar "blipmode"))
(setq old (getvar "pickfirst"))
(setq cmd (getvar "cmdecho"))
(setq os (getvar "osmode"))
(setvar "cmdecho" 0)
(command "undo" "m")
(command "undo" "m")
(setvar "blipmode" 0)
(setvar "pickfirst" 0)
(setvar "osmode" 0)
(prompt "\n选择线变成双线:")
(setq ent_ca (ssget))
(if (= ent_ca nil)
    (exit)
)
(if (= dlw nil)
    (setq dlw 0.3)
)
(princ "\n当前双线宽度:<")
(princ dlw)
(princ "> ")
(setq s (getstring))
(if (/= s "")
    (setq dlw (atof s))
)
(setq len (sslength ent_ca))
(setq cx 0)
(repeat len
    (setq ename (ssname ent_ca cx))
    (setq elist (entget ename))
    (setq entna (dxf 0 elist))
    (cond
      ((= entna "LINE")
       (progn
   (redraw ename 3)
   (line)
   (setq st1 (polar st (+ (angle st ed) (/ pi 2)) (/ dlw 2)))
   (setq ed1 (polar ed (+ (angle st ed) (/ pi 2)) (/ dlw 2)))
   (setq st2 (polar st (+ (angle st ed) (* pi 1.5)) (/ dlw 2)))
   (setq ed2 (polar ed (+ (angle st ed) (* pi 1.5)) (/ dlw 2)))
   (entmake (list (cons 0 "LINE") (cons 10 st1) (cons 11 ed1)))
   (entmake (list (cons 0 "LINE") (cons 10 st2) (cons 11 ed2)))
   (if (> dlw 0.7)
       (progn
         (entmake (list (cons 0 "LINE") (cons 10 st1) (cons 11 st2))
         )
         (entmake (list (cons 0 "LINE") (cons 10 ed1) (cons 11 ed2))
         )
       )
   )
   (entdel ename)
       )
      )
      (T (exit))
    )
    (setq cx (+ cx 1))
)
(setvar "cmdecho" cmd)
(setvar "blipmode" old1)
(setvar "pickfirst" old)
(setvar "osmode" os)
(setq *error* temperr)
(princ)
)

ZZXXQQ 发表于 2016-10-5 07:11:43

本帖最后由 ZZXXQQ 于 2016-10-7 07:04 编辑

(defun c:dkK (/ esel ename entna s st1 st2 ed1 ed2)
(defun dxf (code elst) (cdr(assoc code elst)))
;(setq temperr *error*)
;(setq *error* trap8)
(mapcar 'set '(old1 old cmd os)
    (mapcar 'getvar '("blipmode" "pickfirst" "cmdecho" "osmode"))
)
(command "undo" "m")
(mapcar 'setvar '("cmdecho" "bilipmode" "pickfirst" "osmode") '(0 0 0 0))
(prompt "\n选择线变成双线:")
(if (setq ss (ssget '((0 . "ARC,CIRCLE,LINE")))) (progn
   (if (= dlw nil) (setq dlw 0.3))
   (setq s (getstring (strcat "\n当前双线宽度:<" (rtos dlw 2) "> ")))
   (if (/= s "") (setq dlw (atof s)))
   (repeat (setq i (sslength ss))
    (setq en (ssname ss (setq i (1- i))))
    (setq elist (entget en))
    (redraw en 3)
    (setq enname (dxf 0 elist))
    (cond
      ((= enname "LINE")
       (setq st (dxf 10 elist))
       (setq ed (dxf 11 elist))
       (setq st1 (polar st (+ (angle st ed) (/ pi 2)) (/ dlw 2)))
       (setq ed1 (polar ed (+ (angle st ed) (/ pi 2)) (/ dlw 2)))
       (setq st2 (polar st (+ (angle st ed) (* pi 1.5)) (/ dlw 2)))
       (setq ed2 (polar ed (+ (angle st ed) (* pi 1.5)) (/ dlw 2)))
       (entmake (list (cons 0 "LINE") (cons 10 st1) (cons 11 ed1)))
       (entmake (list (cons 0 "LINE") (cons 10 st2) (cons 11 ed2)))
       (if (> dlw 0.7) (progn
      (entmake (list (cons 0 "LINE") (cons 10 st1) (cons 11 st2)))
      (entmake (list (cons 0 "LINE") (cons 10 ed1) (cons 11 ed2)))
       ))
      )
      ((= enname "CIRCLE")
       (setq pc (dxf 10 elist) r (dxf 40 elist))
       (entmake(list'(0 . "CIRCLE")(cons 10 pc)(cons 40 (+ r (/ dlw 2)))))
       (entmake(list'(0 . "CIRCLE")(cons 10 pc)(cons 40 (- r (/ dlw 2)))))
      )
      ((= enname "ARC")
       (setq pc (dxf 10 elist) r (dxf 40 elist))
       (setq st (polar pc (dxf 50 elist) r))
       (setq ed (polar pc (dxf 51 elist) r))
       (entmake(list'(0 . "ARC")(cons 10 pc)(cons 40 (+ r (/ dlw 2)))(assoc 50 elist)(assoc 51 elist)))
       (entmake(list'(0 . "ARC")(cons 10 pc)(cons 40 (- r (/ dlw 2)))(assoc 50 elist)(assoc 51 elist)))
       (if (> dlw 0.7) (progn
      (setq st1 (polar pc (dxf 50 elist) (+ r (/ dlw 2))))
      (setq st2 (polar pc (dxf 50 elist) (- r (/ dlw 2))))
      (setq ed1 (polar pc (dxf 51 elist) (+ r (/ dlw 2))))
      (setq ed2 (polar pc (dxf 51 elist) (- r (/ dlw 2))))
      (entmake (list (cons 0 "LINE") (cons 10 st1) (cons 11 st2)))
      (entmake (list (cons 0 "LINE") (cons 10 ed1) (cons 11 ed2)))
       ))
      )
   )
   (entdel ename)
    )
))
(mapcar 'setvar '("cmdecho" "blipmode" "pickfirst" "osmode") '(cmd old1 old os))
;(setq *error* temperr)
(princ)
)

程序改了,再试一下。

freeok 发表于 2016-10-5 09:43:15

ZZXXQQ。。。论坛大神更是大大的热心人

xiao88gang 发表于 2016-10-5 11:40:57

ZZXXQQ 发表于 2016-10-5 07:11
程序未经调试

先谢谢了,我试试看。

xiao88gang 发表于 2016-10-5 12:00:39

ZZXXQQ 发表于 2016-10-5 07:11
程序未经调试

亲,未知命令,帮忙调试一下可以吗?谢谢,

ZZXXQQ 发表于 2016-10-6 06:25:02

xiao88gang 发表于 2016-10-5 12:00
亲,未知命令,帮忙调试一下可以吗?谢谢,

请提供所缺函数,否则无法调试。

xiao88gang 发表于 2016-10-6 14:48:30

我也不知道函数,这个是在R14下用的插件。那就算了,不弄了,还是要谢谢你的热心帮助。

Andyhon 发表于 2016-10-6 15:13:41

(mapcaqr 'setvar '("cmdecho" "bilipmode" "pickfirst" "osmode") '(0 0 0 0))
Try ===>
(mapcar 'setvar '("cmdecho" "bilipmode" "pickfirst" "osmode") '(0 0 0 0))

llsheng_73 发表于 2016-10-6 20:59:21

根据楼主提供的程序和所提的问题,基本可以认为,程序不是自己写的
当然,不是说不能用别人的程序进行修改以达到学习的目的,实际上我也经常把别人程序改成自己需要的
起点和过程不重要,最重要的是结果:自己确实学到东西而不是有了一大堆自己需要的程序

zst1978 发表于 2020-2-21 21:21:47


ZZXXQQ 论坛大神更是大大的热心人
页: [1]
查看完整版本: 大家帮我看看这个源码,为什么只对直线起作用,圆和圆弧怎么用不了。