完善“中心线”程序

fqqc

帮我

phoenixdjq

你的程序呢???

fqqc

大哥们,我的程序传上来了,帮我看看,问题如下

1:画出的中心线不能自动归到中心线层

2:画出的中心线不在中心!

3:如果命令执行失败,我设置好的自动捕捉会全部关掉!.

希望大家试用,帮我完善一下!

sen.sam

支持一下，正需要这样的程序，不知道有没有纯autolisp的呢？希望大侠们修改一个autolisp的，就此谢过！

wandong

1:画出的中心线不能自动归到中心线层

(if (not (tblsearch "layer" "cen"))

(command "_layer" "n" "cen" "s" "cen" "l" "center" "cen" "c" "6" "cen" "")
(setvar "clayer" "cen")
)

3:如果命令执行失败,我设置好的自动捕捉会全部关掉!.

(....

;;;主函数

(setq olderror *error*)
(setq *error* zxx_err)
(command "_undo" "be")

.......

(command)

(command "._undo" "_end")
(setvar "clayer" oldlayer)

(setvar "osmode" os)
(setq *error* olderror)
(princ)

)

;;;错误处理函数

(defun zxx_err(msg)
(command)
(command "._undo" "_end")
(setvar "clayer" oldlayer)

(setvar "osmode" os)
(setq *error* olderror)
(princ)

)

卡卡西

(
  defun c:zx()
    (prompt "欢迎您用此程序")
    (setvar "cmdecho" 0)
 

;创建新层
 
    (setq oldvar (getvar "OSMODE"))
    (setvar "OSMODE" 512)
    (command "pline")
    (while (= 1 1)
 
       (setq p1 (getpoint "\n请选择第一个点："))
       
        (setq firstX (car p1))
        (setq firstY (cadr p1))
        (setq p2 (getpoint "\n请选择第二个点："))
        (if p2
   (progn
           (setq secondX (car p2))
            (setq secondY (cadr p2))
            (setq mX (/ (+ firstX secondX) 2))
            (setq mY (/ (+ firstY secondY) 2))
            (setq mX (rtos mX))
            (setq mY (rtos mY))
            (command (strcat mX "," mY))
    )
   (progn
    (command "") 
   )

        )
 
    )
    (setvar "OSMODE" oldvar)
    (princ)
 
)

试试这个！

fqqc

谢谢大哥的提示啦,但是对LISP程序不是太懂,所以还是搞不定啦!

能不能把修改好的程序发给我啦@!

谢谢啦!

xyp1964

zxx(中心线).vlx 适用于区域和实体