真是高手如云，羡慕呀。真的要好好学习一下lisp了，祝高手们牛气冲天，更牛 caoyin发表于2008-12-18 14:04:00static/image/common/back.gif....此程序缺少函数(LTAX:DOC) (LTAX:BLKS)呀，请楼主补上吧
<p></p>
回复：（zhongzilei）以下是引用caoyin在2008-12-18 1...
函数已经添加 试了新修改的程序不能用呀，看看怎么回事 回49楼 jxphklibin：KEYWD在此处不是函数，相当于(if KEYWD (strcat KEYWD " ")) <br/>回53楼 zhongzilei：那个程序？发现什么问题？ ncopy.lsp程序，我这里下了几次新修改过函数的程序，加载后都没有什么反应 ;;我在不同版本使用是发现了一些问题，修改了一下(defun C:NCOPY
(/ OS CM QA EM SS NEN $LT-ENTSEL$ EN ES EP P1 ELST TYP EN1 PP P2 SC DOC BLKS BLK)
;;-----------------------------------------------------
;;本程序支持函数
(defun lt:list-sub (lst sta len / item n)
(setq item (nth sta lst) n (- (length lst) sta))
(while (/= (length (setq lst (member item lst))) n) (setq lst (cdr lst)))
(setq item (nth (1- len) lst) lst (reverse lst))
(while (/= (length (setq lst (member item lst))) len) (setq lst (cdr lst)))
(reverse lst)
)
(defun lt:ss->list (ss / lst)
(foreach x (ssnamex ss)
(if (= (car x) 3) (setq lst (append lst (list (cadr x)))))
)
lst
)
;;-----------------------------------------------------
(sssetfirst nil nil)
(setq OS (getvar "osmode")
CM (getvar "cmdecho")
QA (getvar "qaflags")
EM (getvar "explmode")
)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setvar "qaflags" 1)
(setvar "explmode" 1)
(setq SS (ssadd))
(princ "\n复制块、多段线、多线或标注中的套嵌对象...")
(setq $LT-ENTSEL$ T)
(while (setq NEN (lt:entsel nil nil nil))
(if (= (length NEN) 2)
(setq EN (car NEN))
(setq EN (car (last NEN)))
)
(cond ((if (ssmemb EN SS)
(princ "重复选择，忽略。")
(progn
(setq ELST (entget EN)
TYP(cdr (assoc 0 ELST))
)
nil
)
)
)
((= TYP "MLINE")
(entmake ELST)
(setq EN1 (entlast))
(command "_.explode" EN1 "")
(setq ES(lt:ss->list (ssget "_P"))
P1(cadr NEN)
EN1 (nth (car (vl-sort-i
(mapcar '(lambda (X)
(distance (vlax-curve-getClosestPointTo X P1) P1)
)
ES
)
'<
)
)
ES
)
)
(foreach X ES
(if (not (eq X EN1)) (entdel X))
)
)
((= TYP "LWPOLYLINE")
(setq PP (fix (vlax-curve-getParamAtPoint
EN
(apply 'vlax-curve-getClosestPointTo NEN)
)
)
ELST1 (lt:list-sub ELST 0 (vl-position (assoc 10 ELST) ELST))
ELST1 (subst '(70 . 0) (assoc 70 ELST1) ELST1)
ELST2 (member (assoc 10 ELST) ELST)
ELST3 (member (assoc 210 ELST2) ELST2)
)
(if (and (vlax-curve-isClosed EN)
(/= (setq EP (vlax-curve-getEndParam EN)) 1)
(= EP (1+ PP))
)
(setq ELST2 (append (lt:list-sub ELST2 (* PP 4) 4)
(lt:list-sub ELST2 0 4)
)
)
(setq ELST2 (lt:list-sub ELST2 (* PP 4) 8))
)
(entmake (append ELST1 ELST2 ELST3))
(setq EN1 (entlast))
)
((= TYP "INSERT")
(setq SC (mapcar '(lambda (X) (assoc X ELST)) '(10 41 42 43 50))
P1 (cdar SC)
SC (cdr SC)
)
(entmake (entget (car NEN)))
(setq EN1 (entlast)
DOC (vla-get-activedocument (vlax-get-acad-object))
BLKS (vla-get-Blocks DOC)
)
(vlax-invoke DOC
'CopyObjects
(list (en2obj EN1))
(setq BLK (vla-add BLKS (vlax-3d-point '(0 0 0)) "*U"))
)
(setq BLK (vla-get-name BLK))
(entdel EN1)
(entmake (vl-list* '(0 . "INSERT") (cons 2 BLK) (cons 10 P1) SC))
(setq EN1 (entlast))
(vl-catch-all-apply 'vla-delete (list (vla-item BLKS BLK)))
)
((= TYP "ATTRIB")
(princ "\n所选对象为属性，自动转换为单行文字...")
(setq ELST (vl-remove-if '(lambda (X)
(member (car X) '(-1 0 330 5 100 2 70 71 72 74))
)
ELST
)
)
(entmake (cons '(0 . "TEXT") ELST))
(setq EN1 (entlast))
)
((= TYP "DIMENSION")
(entmake (entget (car NEN)))
(setq EN1 (entlast))
)
(T (command "_.copy" EN "" "0,0" "0,0")
(while (/= 0 (getvar "cmdactive")) (command ""))
(setq EN1 (entlast))
)
)
(if EN1
(progn
(command "_.draworder" EN1 "" "_f")
(ssadd EN1 SS)
(redraw EN1 3)
)
)
)
(if (and SS (/= (sslength SS) 0))
(progn
(setvar "osmode" OS)
(if (setq P1 (getpoint "\n指定基点 <原位置>: "))
(progn
(command "_.move" SS "" "_non" P1)
(princ "指定第二点: ")
(command "\\")
)
)
(if (equal (getvar "lastpoint") P1 1e-7)
(command "_.erase" SS "")
)
(command "_.select" SS "")
(if (setq SS1 (ssget "_P" '((0 . "INSERT"))))
(command "_.explode" SS1 "");;;
)
(command "_.select" SS "")
)
)
(setvar "cmdecho" CM)
(setvar "osmode" OS)
(setvar "qaflags" QA)
(setvar "explmode" EM)
(princ)
) <p>版主，在CAD2006下试了还是不行的，输入命令有如下提示,就结束了</p><p>命令: ap<br/>APPLOAD 已成功加载 NCOPY.lsp。</p><p><br/>命令:<br/>命令:<br/>命令: NCOPY</p><p>复制块、多段线、多线或标注中的套嵌对象...<br/>命令:</p> 你一行一行代码测试一下，把出错的地方发给我看看 <p>缺少函数:LT:ENTSEL，加上即可以</p><p>但复制块中对象时会提示如下信息:</p><p>no function definition: EN2OBJ</p><p></p>