动态多重复制

KO你

原帖http://bbs.mjtd.com/forum.php?mo ... hlight=%B8%B4%D6%C6
参考狼大的多重复制优化了一下，目前遇到的问题和狼版的一样，
有时同方向复制空格多了，会出现重复复制到同个位置重叠，
有时又没问题，不知道是什么原因。
分享给大家使用。可以一起探讨解决
快捷键  cc  多重复制
(defun c:cc (/ *error* ent lastEnt basePt nextPt dist ang ss userError)
(princ "动态多重复制\n")
(defun *error* (msg)
(command ".UNDO" "E")
(setvar "osmode" oldSnap)
(setq *error* userError))
(setq oldSnap (getvar "osmode")
userError *error*
*error* *error*
cmdEcho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(if (and (setq ss (ssget))
(setq basePt (getpoint "\n指定基点: ")))
(progn
(command ".UNDO" "BE")
(setq dist nil ang 0)
(while (princ "\n指定下一点或距离: ")
(if dist (princ (strcat "<" (rtos dist) ">: ")))
(setq lastEnt (entlast))
(command ".copy" ss "" basePt pause)
(setq nextPt (getvar "lastpoint"))
(command ".erase" (ssdelDraft lastEnt) "")
(if (equal basePt nextPt 1e-8)
(setq nextPt (polar basePt ang dist))
(setq dist (distance basePt nextPt)
ang (angle basePt nextPt)))
(setq lastEnt (entlast))
(command ".copy" ss "" basePt nextPt)
(setq ss (ssdelDraft lastEnt)
basePt nextPt))
(command ".UNDO" "E")))
(setvar "osmode" oldSnap)
(setq *error* userError)
(princ))
(defun ssdelDraft (ent / ss entData)
(setq ss (ssadd))
(while (setq ent (entnext ent))
(setq entData (entget ent))
(if (not (wcmatch (cdr (assoc 0 entData)) "ATTRIB,VERTEX,SEQEND"))
(ssadd ent ss)))ss)

hubeiwdlue

院长说的对，捕捉的问题，还有就是把容差取大一点点试一下

KO你

hubeiwdlue 发表于 2025-6-26 15:41
院长说的对，捕捉的问题，还有就是把容差取大一点点试一下

(defun c:cc (/ *error* ent lastEnt basePt nextPt dist ang ss userError)
(princ "动态多重复制\n")
(defun *error* (msg)
(command ".UNDO" "E")
(setvar "osmode" oldSnap);;这里的oldSnap改成0,或者这行都删掉
(setq *error* userError))
(setq oldSnap (getvar "osmode")
userError *error*
*error* *error*
cmdEcho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(if (and (setq ss (ssget))
(setq basePt (getpoint "\n指定基点: ")))
(progn
(command ".UNDO" "BE")
(setq dist nil ang 0)
(while (princ "\n指定下一点或距离: ")
(if dist (princ (strcat "<" (rtos dist) ">: ")))
(setq lastEnt (entlast))
(command ".copy" ss "" basePt pause)
(setq nextPt (getvar "lastpoint"))
(command ".erase" (ssdelDraft lastEnt) "")
(if (equal basePt nextPt 1e-8)
(setq nextPt (polar basePt ang dist))
(setq dist (distance basePt nextPt)
ang (angle basePt nextPt)))
(setq lastEnt (entlast))
(command ".copy" ss "" basePt nextPt)
(setq ss (ssdelDraft lastEnt)
basePt nextPt))
(command ".UNDO" "E")))
(setvar "osmode" oldSnap);;这里的oldSnap改成0,或者这行都删掉
(setq *error* userError)
(princ))
(defun ssdelDraft (ent / ss entData)
(setq ss (ssadd))
(while (setq ent (entnext ent))
(setq entData (entget ent))
(if (not (wcmatch (cdr (assoc 0 entData)) "ATTRIB,VERTEX,SEQEND"))
(ssadd ent ss)))ss)
请问是否这样修改

以下修改是完全没有捕捉设置，复制对象捕捉不到点，已经失去功能的意义
(defun c:cc (/ *error* ent lastEnt basePt nextPt dist ang ss userError oldSnap)
(princ "动态多重复制\n")
(defun *error* (msg)
(command ".UNDO" "E")
(if oldSnap (setvar "osmode" oldSnap))  ; 确保恢复捕捉设置
(setq *error* userError)
(princ))
(setq userError *error*
oldSnap (getvar "osmode")
cmdEcho (getvar "cmdecho"))
(setvar "cmdecho" 0)  
(if (and (setq ss (ssget))
(setq basePt (getpoint "\n指定基点: ")))
(progn
(command ".UNDO" "BE")
(setq dist nil ang 0)
(setvar "osmode" 0)  ; 关键修改：关闭对象捕捉   
(while (princ "\n指定下一点或距离: ")
(if dist (princ (strcat "<" (rtos dist) ">: ")))
(setq lastEnt (entlast))
(command ".copy" ss "" basePt pause)
(setq nextPt (getvar "lastpoint"))
(command ".erase" (ssdelDraft lastEnt) "")
(if (equal basePt nextPt 1e-8)
(setq nextPt (polar basePt ang dist))
(setq dist (distance basePt nextPt)
ang (angle basePt nextPt)))   
(setq lastEnt (entlast))
(command ".copy" ss "" basePt nextPt)
(setq ss (ssdelDraft lastEnt)
basePt nextPt))
(command ".UNDO" "E")))
(setvar "osmode" oldSnap)  ; 恢复原始捕捉设置
(setq *error* userError)
(princ))
(defun ssdelDraft (ent / ss entData)
(setq ss (ssadd))
(while (setq ent (entnext ent))
(setq entData (entget ent))
(if (not (wcmatch (cdr (assoc 0 entData)) "ATTRIB,VERTEX,SEQEND"))
(ssadd ent ss)))ss)