1078815748 发表于 2011-7-15 09:39:24

Andyhon 发表于 2011-7-15 10:02:06


(defun c:ab ()
(setvar "osmode" 0)

(while (setq nn (car (entsel "\n请选檡原图框")))
    (setq nn1 (entnext nn))
    (setq ww (entget nn1))
   .... snip(略)
      (setq ww1 (entget mm))
      (setq a1 (cdr (assoc 0 ww1)))
    )
)
(setvar "osmode" 37)
(princ)
) ;_ end defun
未测...

1078815748 发表于 2011-7-15 10:13:51

zyhandw 发表于 2011-7-15 10:24:18

没看出来这个程序是做什么用的

1078815748 发表于 2011-7-15 10:31:29

Andyhon 发表于 2011-7-15 10:34:26

回复 1078815748 的帖子

方便上传 调试用图纸+成果 (*.Dwg) 吗?

zwqgdhl 发表于 2011-7-15 10:48:36

可以把原程序语句
(setq mm1 (car (entsel"\n請選檡目標圖框")))
(setq mm(entnext mm1))
(setq ww1 (entget mm))
(setq a1 (cdr(assoc 0 ww1)))


改为下面这种形式
(princ "\n可选多个<替换对象>: ")
(setq ss (ssget))(setq i 0)
(repeat (sslength ss)
    (setq ssn (ssname ss i))
    (setq ssdata (entget ssn))
    (setq a1 (cdr (assoc 0 ssdata)))
    (setq i (1+ i))
)

1078815748 发表于 2011-7-15 10:55:33

zwqgdhl 发表于 2011-7-15 10:56:24

完整程序即

;複製圖框內容(AB)
(defun c:ab()
(setvar "osmode" 0)
(setq nn (car (entsel"\n請選檡原圖框")))
(setq nn1(entnext nn))
(setq ww (entget nn1))
(setq b1 (cdr(assoc 0 ww)))
(setq c (cdr (assoc 2 ww)))
(setq d (cdr(assoc 1 ww)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ "\n可选多个目標圖框")
(setq ss (ssget))(setq i 0)
(repeat (sslength ss)
    (setq ssn (ssname ss i))
    (setq ssdata (entget ssn))
    (setq a1 (cdr (assoc 0 ssdata)))
    (setq i (1+ i))
)
(while (= b1 "ATTRIB")
   (setq flag1 1)
   (while (and (= flag1 1)(= a1 "ATTRIB"))
         (setq c1 (cdr (assoc 2 ww1)))
         (if (= c c1)
   (progn
       (setq e(assoc 1 ww1))
       (setq d1(cons 1 d))
       (setq ww2(subst d1 e ww1))
       (entmod ww2)
       (entupd mm)
       (setq flag1 0)
             ))
          (if (= flag1 1)
    (progn
          (setq mm(entnext mm))
          (setq ww1(entget mm))
          (setq a1(cdr(assoc 0 ww1)))
    ))
   )
          (setq nn1 (entnext nn1))
          (setq ww(entget nn1))
          (setq b1(cdr (assoc 0 ww)))
          (setq c (cdr (assoc 2 ww)))
          (setq d (cdr (assoc 1 ww)))
          (setq mm mm1)
          (setq mm(entnext mm))
          (setq ww1(entget mm))
          (setq a1(cdr(assoc 0 ww1)))         
)
(setvar "osmode" 37)
(princ)
);end defun

ljpnb 发表于 2011-7-15 10:57:17

本帖最后由 ljpnb 于 2011-7-15 12:11 编辑

未测试

;;;複製圖框內容(AB)
(defun c:ab ()
(setvar "osmode" 0)
(if (setq nn (car (entsel "\n請選檡原圖框")))
    (progn
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
      (princ "\n可选多个目標圖框: ")
      (if (setq ss (ssget)
i0
   )
(repeat (sslength ss)
   (setq nn1 (entnext nn))
   (setq ww (entget nn1))
   (setq b1 (cdr (assoc 0 ww)))
   (setq c (cdr (assoc 2 ww)))
   (setq d (cdr (assoc 1 ww)))
   (setq mm1 (ssname ss i))
   (setq mm (entnext mm1))
   (setq ww1 (entget mm))
   (setq a1 (cdr (assoc 0 ww1)))
   (while (= b1 "ATTRIB")
   (setq flag1 1)
   (while (and (= flag1 1) (= a1 "ATTRIB"))
       (setq c1 (cdr (assoc 2 ww1)))
       (if (= c c1)
(progn
    (setq e (assoc 1 ww1))
    (setq d1 (cons 1 d))
    (setq ww2 (subst d1 e ww1))
    (entmod ww2)
    (entupd mm)
    (setq flag1 0)
)
       )
       (if (= flag1 1)
(progn
    (setq mm (entnext mm))
    (setq ww1 (entget mm))
    (setq a1 (cdr (assoc 0 ww1)))
)
       )
   )
   (setq nn1 (entnext nn1))
   (setq ww (entget nn1))
   (setq b1 (cdr (assoc 0 ww)))
   (setq c (cdr (assoc 2 ww)))
   (setq d (cdr (assoc 1 ww)))
   (setq mm mm1)
   (setq mm (entnext mm))
   (setq ww1 (entget mm))
   (setq a1 (cdr (assoc 0 ww1)))
   )
   (setq i (1+ i))
)
      )
    )
)
(setvar "osmode" 37)
(princ)
)   ;end defun

页: [1] 2
查看完整版本: 形式