层复制有点问题,烦请各位高手帮忙修改并问题所在,谢谢! 我的邮箱:xiongdc@163.com

xiongdc · 发表于 2006-4-23 08:54:00

(DEFUN C:CF()(SETQ SS(SSGET))
             (if(= ss nil)
             (progn (prompt "\n---*error*选取对象---")
             (setq ss (ssget))))
             (setq s(getint"\n请输入复制方式1)输入层名: (2)选择该层物体: "))
             (if (= S 2 )(progn (while
             (setq LAY (entsel "\n选择该层物体 "))
             (setq LAY (cdr (assoc 8 (entget (car LAY)))))
             (if ( = lay nil)(progn(SETQ LAY(getstring "\n---*error*再一次输入---"))))
             (princ)(COMMAND"COPY" SS "" "0,0" "0,0" )
             (COMMAND "CHPROP" SS "" "LA" lay "" "" "")))
             (princ))(if (or(= S 1 ) (= s nil))
             (progn(while(SETQ LAY(GETSTRING"\n层名:_______"))
             (COMMAND"COPY" SS "" "0,0" "0,0" )
             (COMMAND "CHPROP" SS "" "LA" lay "" "" ""))))
             (if ( = lay nil)(progn(SETQ LAY(getstring "\n---*error*再一次输入---"))))
             (princ)(command "ucs" "v")
             (command "undo" "end")(PRINC))

Andyhon · 发表于 2006-4-23 09:38:00

(DEFUN C:CF ()
(cond
   ((not (SETQ SS (SSGET))))
   (T
    (setq s (getint "\n请输入复制方式

1)输入层名: (2)选择该层物体: "))
    (cond
     ((= S 2)
      (while (setq LAY (entsel "\n选择该层物体 "))
        (setq LAY (cdr (assoc 8 (entget (car LAY)))))
        (COMMAND "COPY" SS "" "0,0" "0,0")
        (COMMAND "CHPROP" SS "" "LA" lay "")
      )
     )
     ((or (= S 1) (= s nil))
      (while (/= (SETQ LAY (GETSTRING "\n层名: ")) "")
        (COMMAND "COPY" SS "" "0,0" "0,0")
        (COMMAND "CHPROP" SS "" "LA" lay "")
      )
     )
    )
   )
)
(PRINC)
)

andyding · 发表于 2006-4-23 13:35:00

你试试看。这个程序好像是隆腾的。

我是搞端子模具的。

(DEFUN C:CF ()
(SETQ SS (SSGET))
(if (= ss nil)
    (progn (prompt "\n---*error*选取对象---")
    (setq ss (ssget))
    )
)
(setq s (getint "\n请输入复制方式1)输入层名: (2)选择该层物体: "))
(if (= S 2)
    (progn
      (while
(setq la (entsel "\n选择该层物体 "))
(setq la (cdr (assoc 8 (entget (car la)))))
(if (= la nil)
    (progn (SETQ la (getstring "\n---*error*再一次输入---")))
)
(princ)
(COMMAND "COPY" SS "" "0,0" "0,0")
(COMMAND "CHPROP" SS "" "LA" la "")
      )
    )
    (princ)
)
(if (or (= S 1) (= s nil))
    (progn (while (SETQ LAY (GETSTRING "\n层名:_______"))
      (COMMAND "COPY" SS "" "0,0" "0,0")
      (COMMAND "CHPROP" SS "" "LA" lay "")
    )
    )
)
(if (= lay nil)
    (progn (SETQ LAY (getstring "\n---*error*再一次输入---")))
)
(princ)
(command "ucs" "v")
(command "undo" "end")
(PRINC)
)

xyp1964 · 发表于 2006-4-23 22:44:00

原地复制有何意义？！

xiongdc · 发表于 2006-4-24 22:45:00

流浪剑客,谢谢你!我也是搞端子模具设计的,很高兴认识你!

那个程序还是不能结束,要怎么修改,现在用得很不方便,拜托帮忙!

xiongdc · 发表于 2006-4-24 22:47:00

流浪剑客,有时间,我们QQ上聊聊,我的:290518079

xiongdc · 发表于 2006-4-24 23:06:00

xyp1964,非常谢谢你,上次您帮我改的这个程序不能执行,烦请你再帮我改改,因为我不是很懂LISP 语言!拜托

xyp1964 · 发表于 2006-4-24 23:44:00

(load "xyp_lib.vlx") ;版本 V.20060314
;|下载和加载通用函数(可在签名栏直接下载后放到搜索路径下)
利用以下任何一种方式（首选第一种）即可加载和运行通用函数内的所有子程序：
★1·在acad.lsp中增加(load"xyp_lib")
■2·在每个程序内增加(load"xyp_lib")
■3·在command下，输入(load"xyp_lib")
■4·在菜单.mnl中增加(load"xyp_lib")
■5·将xyp_lib.vlx文件直接拽到cad屏幕
[COLOR=red] ★通用函数下载地址：[/COLOR]
[url]http://bbs.mjtd.com/forum.php?mod=viewthread&tid=37554[/url]
|;
(DEFUN C:CF ()
(cmdla0)
(if (null ukw) (setq ukw "1"))
(SETQ ukw (UKWORD 7 "1 2" "\n请输入复制方式 : 1-输入层名/2-选择目标层物体" ukw))
(setvar "osmode" 0)
(prompt "\n选取对象: ")
(if (SETQ SS (SSGET))
(cond ((= ukw "2")
(while (not (setq s1 (car (entsel "\n选择目标层物体: ")))))
(setq LAY (xyp-get-dxf 8 s1))
(COMMAND "COPY" SS "" "0,0" "0,0")
(COMMAND "CHPROP" SS "" "LA" lay "")
)
((= ukw "1")
(SETQ STR (USTR 7 "\n输入层名" STR nil))
(xyp-mkla str)
(COMMAND "COPY" SS "" "0,0" "0,0")
(COMMAND "CHPROP" SS "" "LA" str "")
)
)
)
(cmdla1)
)

andyding · 发表于 2006-4-25 18:11:00

有缘！我在东莞长安。

(DEFUN C:CF ()
(SETvar "CMDECHO" 0)
(vl-cmdf "_.undo" "_group")
(SETQ SS (SSGET))
(if (= ss nil)
    (progn (prompt "\n---*error*选取对象---")
    (setq ss (ssget))
    )
)
(setq s (getint "\n请输入复制方式1)输入层名: (2)选择该层物体: "))
(if (= S 2)
    (progn

      (setq la (entsel "\n选择该层物体 "))
      (setq la (cdr (assoc 8 (entget (car la)))))
      (if (= la nil)
(progn (SETQ la (getstring "\n---*error*再一次输入---")))
      )
      (princ)
      (COMMAND "COPY" SS "" "0,0" "0,0")
      (COMMAND "CHPROP" SS "" "LA" la "")

    )
    (princ)
)
(if (or (= S 1) (= s nil))
    (progn (SETQ LAY (GETSTRING "\n层名:_______"))
    (COMMAND "COPY" SS "" "0,0" "0,0")
    (COMMAND "CHPROP" SS "" "LA" lay "")

)
)
(if (= lay nil)
(progn (SETQ LAY (getstring "\n---*error*再一次输入---")))
)
(princ)
(command "ucs" "v")
(vl-cmdf "_.undo" "_end")
(SETvar "CMDECHO" 1)
(PRINC)
)

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