请陈老师或各位高手帮个忙编个程序(能实现在图低中批量代换图形的功能。)

龙龙仔 · 发表于 2003-4-7 10:50:00

(defun C:SUM_CIRCLE
   (/ HOLDOSMODE HOLDZIN HOLDECHO HOLE_LIST #FF R1_LIST)

  (defun WRITE_LINE (/ LL)
(setq #FF (polar #FF (/ pi 2.0) (* #H 1.5)))
(command "_.line"
      (polar #FF pi (* #H 4.5))
      (polar #FF 0 (* #H 9))
      ""
)
(command "_.ARRAY"
      (entlast)
      ""
      "R"
      (+ (length R1_LIST) 2)
      ""
      (* -2 #H)
)
(command "_.line"
      (polar #FF pi (* #H 4.5))
      (cdr (assoc 10 (entget (entlast))))
      ""
)
(setq LL (entlast))
(command "_.COPY" LL "" #FF (polar #FF 0 (* #H 9.5)))
(command "_.COPY" LL "" #FF (polar #FF 0 (* #H 13.5)))
  )

  (defun WRITE_TABLE (H_LIST / DATA #F)
(if (= #H NIL)
   (setq #H 5)
)
(while (= #F NIL)
   (initget 1 "

")
(setq #F (getpoint "\n表格左上角/字体高度<

>: "))
(if (= #F "

")
(progn
   (setq
      #H (getreal (strcat "\n字体高度<" (rtos #H 2 0) ">: "))
   )
   (setq #F NIL)
)
   )
)
(setq #FF #F)
(command "_.text" "j" "C" #F #H "" "直径")
(command "_.text"
      "j"
      "C"
      (polar #F 0 (* #H 7))
      #H
      ""
      "数量"
)
(setq #F (polar #F (/ pi -2.0) (* #H 2)))
(while (/= (setq DATA (car H_LIST)) NIL)
   (command "_.text"
         "j"
         "BR"
         (polar #F 0 (* #H 3.5))
         #H
         ""
         (strcat "%%c" (rtos (* (car DATA) 2.0) 2 2))
   )
   (command "_.text"
         "j"
         "C"
         (polar #F 0 (* #H 7))
         #H
         ""
         (rtos (cadr DATA))
   )

   (setq #F (polar #F (/ pi -2.0) (* #H 2)))
   (setq H_LIST (cdr H_LIST))
)
  )

  (defun MAKE_LIST (/ SS N R_LIST TMP)
(if (setq SS (ssget "X" '((0 . "CIRCLE"))))
   (progn
(setq N 0)
(repeat (sslength SS)
   (if (not (member
      (setq TMP (cdr (assoc 40 (entget (ssname SS N)))))
      R_LIST
   )
      )
      (setq R_LIST (append R_LIST (list TMP)))
   )
   (setq N (1+ N))
)
   )
)
(setq N 0)
(repeat (length R_LIST)
   (setq
TMP (ssget "X"
   (list (cons 0 "CIRCLE") (cons 40 (nth N R_LIST)))
      )
   )
   (setq
R1_LIST (append R1_LIST
(list (list (nth N R_LIST) (sslength TMP)))
)
   )
   (setq N (1+ N))
)
  )

  (setq HOLDECHO (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "_.UNDO" "_GROUP")
  (setq HOLDOSMODE (getvar "OSMODE"))
  (setq HOLDZIN (getvar "DIMZIN"))
  (setvar "DIMZIN" 8)
  (setvar "OSMODE" 0)
  (MAKE_LIST)
  (WRITE_TABLE R1_LIST)
  (WRITE_LINE)
  (setvar "OSMODE" HOLDOSMODE)
  (setvar "DIMZIN" HOLDZIN)
  (command "_.UNDO" "_END")
  (setvar "CMDECHO" HOLDECHO)
  (princ)
)

wujin · 发表于 2003-4-7 22:34:00

wujin · 发表于 2003-4-8 21:47:00

符号那一列只要留一列空间就行了，我可以自己画圆代换进去，然后再用块代换程序代换。或者龙大哥帮忙也搞个每种圆画在序号这一列上面，那就太好了。我想再在孔径一列后面再加一列冲针，内容和孔径里面的一样。这样不知道行不行哪。再帮我搞一下吧，谢谢大哥啦。本人太菜啦，看了程序不会改。

龙龙仔 · 发表于 2003-4-9 17:02:00

wujin · 发表于 2003-4-9 20:45:00

我晕倒，不是吧，龙仔，我手上没有书呀。我都是看的ACAD的帮助文件，那我自己改着试一下。[br]

wujin · 发表于 2003-4-10 01:01:00

;圓孔統計表>>>
(defun C:tjbok
   (/ HOLDOSMODE HOLDZIN HOLDECHO HOLE_LIST #FF R1_LIST)

  (defun WRITE_LINE (/ LL)
(setq #FF (polar #FF (/ pi 2.0) (* #H 1.5)))
(command "_.line"
      (polar #FF pi (* #H 4.5))
      (polar #FF 0 (* #H 14))
      ""
)
(command "_.ARRAY"
      (entlast)
      ""
      "R"
      (+ (length R1_LIST) 2)
      ""
      (* -2 #H)
)
(command "_.line"
      (polar #FF pi (* #H 4.5))
      (cdr (assoc 10 (entget (entlast))))
      ""
)
(setq LL (entlast))
(command "_.COPY" LL "" #FF (polar #FF 0 (* #H 4.3)))
(command "_.COPY" LL "" #FF (polar #FF 0 (* #H 9.5)))
(command "_.COPY" LL "" #FF (polar #FF 0 (* #H 13.5)))
(command "_.COPY" LL "" #FF (polar #FF 0 (* #H 18.5)))
  )

  (defun WRITE_TABLE (H_LIST / DATA #F)
(if (= #H NIL)
   (setq #H 5)
)
(while (= #F NIL)
   (initget 1 "

")
(setq #F (getpoint "\n表格左上角/字体高度<

>: "))
(if (= #F "

")
(progn
   (setq
      #H (getreal (strcat "\n字体高度<" (rtos #H 2 0) ">: "))
   )
   (setq #F NIL)
)
   )
)
(setq #FF #F)
(command "_.text" "j" "C" #F #H "" "符号  孔径")
(command "_.text"
      "j"
      "C"
      (polar #F 0 (* #H 7))
      #H
      ""
      "冲针"
)
(command "_.text"
      "j"
      "C"
      (polar #F 0 (* #H 12))
      #H
      ""
      "数量"
   )
(setq #F (polar #F (/ pi -2.0) (* #H 2)))
(while (/= (setq DATA (car H_LIST)) NIL)
   (command "_.text"
         "j"
         "BR"
         (polar #F 0 (* #H 3.5))
         #H
         ""
         (strcat "Φ" (rtos (* (car DATA) 2.0) 2 2))
   )
   (command "_.text"
         "j"
         "C"
         (polar #F 0 (* #H 7))
         #H
         ""
         (strcat "Φ" (rtos (* (car DATA) 2.0) 2 2))
   )
   (command "_.text"
         "j"
         "C"
         (polar #F 0 (* #H 12))
         #H
         ""
         (rtos (cadr DATA))
   )
   (command "_.circle"
         (polar #F 0 (* #H -3))
         (car DATA)
         ""
   )
   (setq #F (polar #F (/ pi -2.0) (* #H 2)))
   (setq H_LIST (cdr H_LIST))
)
  )

  (defun MAKE_LIST (/ SS N R_LIST TMP)
(if (setq SS (ssget "X" '((0 . "CIRCLE"))))
   (progn
(setq N 0)
(repeat (sslength SS)
   (if (not (member ;MEMBER搜索表R_LIST中是否包含图元为N的半径表达式，并从该表达式的第一次出现处返回表的其余部分
      (setq TMP (cdr (assoc 40 (entget (ssname SS N)))));TMP为SS集中图元名为N的半径
      R_LIST;如果R_LIST表中没有图元名为N的半径值。
   )
      )
      (setq R_LIST (append R_LIST (list TMP)));append将R_LIST和TMP表组合成一个表
   );将R_LIST表和N图元的半径值组合成一个R_LIST表(包含图中圆的所有半径)
   (setq N (1+ N))
)
   )
);遍历选择集SS中所有圆的半径值并组成一个表R_LIST
(setq N 0)
(repeat (length R_LIST);以表中所有的半径的总的数目做循环
   (setq
TMP (ssget "X"
   (list (cons 0 "CIRCLE") (cons 40 (nth N R_LIST)))
      );NTH为返回表中的第 n 个元素
   );设定选择集TMP为表R_LIST中第N个半径值的数量和
   (setq
R1_LIST (append R1_LIST
(list (list (nth N R_LIST) (sslength TMP)))
)
   );设定表R1_LIST为所有的圆的每种圆的半径，数量
   (setq N (1+ N))
)
  )

  (setq HOLDECHO (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "_.UNDO" "_GROUP")
  (setq HOLDOSMODE (getvar "OSMODE"))
  (setq HOLDZIN (getvar "DIMZIN"))
  (setvar "DIMZIN" 8)
  (setvar "OSMODE" 0)
  (MAKE_LIST)
  (WRITE_TABLE R1_LIST)
  (WRITE_LINE)
  (setvar "OSMODE" HOLDOSMODE)
  (setvar "DIMZIN" HOLDZIN)
  (command "_.UNDO" "_END")
  (setvar "CMDECHO" HOLDECHO)
  (princ)
)

龙龙仔 · 发表于 2003-4-10 08:39:00

本帖最后由作者于 2003-4-10 8:39:54 编辑

(command "_.text"
         "j"
         "BR" ;應為"C"
         (polar #F 0 (* #H 3.5));修改位置2.5
         #H
         ""
         (strcat "Φ" (rtos (* (car DATA) 2.0) 2 2))
   )
   (command "_.text"
         "j"
         "C"
         (polar #F 0 (* #H 7))
         #H
         ""
         (strcat "Φ" (rtos (* (car DATA) 2.0) 2 2))
   )
   (command "_.text"
         "j"
         "C"
         (polar #F 0 (* #H 12))
         #H
         ""
         (rtos (cadr DATA))
   )
   (command "_.circle"
         (polar #F 0 (* #H -3))
         (car DATA)
            "" ;;取消
   )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(MAKE_LIST)
  (WRITE_TABLE
(vl-sort R1_LIST
      (function (lambda (E1 E2)
   (< (car E1) (car E2))
         )
      )
)
  )
  (WRITE_LINE)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

wujin · 发表于 2003-4-12 11:36:00

;圓孔統計表>>>
(defun C:tjbok
         (/ HOLDOSMODE HOLDZIN HOLDECHO HOLE_LIST #FF R1_LIST)

  (defun WRITE_LINE (/ LL)
(setq #FF (polar #FF (/ pi 2.0) (* #H 1.5)))
(command "_.line"
      (polar #FF pi (* #H 4.5))
      (polar #FF 0 (* #H 19))
      ""
)
(command "_.ARRAY"
      (entlast)
      ""
      "R"
      (+ (length R1_LIST) 2)
      ""
      (* -2 #H)
)
(command "_.line"
      (polar #FF pi (* #H 4.5))
      (cdr (assoc 10 (entget (entlast))))
      ""
)
(setq LL (entlast))
(command "_.COPY" LL "" #FF (polar #FF 0 (* #H 4.3)))
(command "_.COPY" LL "" #FF (polar #FF 0 (* #H 9.5)))
(command "_.COPY" LL "" #FF (polar #FF 0 (* #H 13.5)))
(command "_.COPY" LL "" #FF (polar #FF 0 (* #H 18.5)))
(command "_.COPY" LL "" #FF (polar #FF 0 (* #H 23.5)))
  )

  (defun WRITE_TABLE (H_LIST / DATA #F zj)
(if (= #H NIL)
   (setq #H 5)
)
(setq zj 0)
(while (= #F NIL)
   (initget 1 "

")
(setq #F (getpoint "\n表格左上角/字体高度<

>: "))
(if (= #F "

")
(progn
   (setq
      #H (getreal (strcat "\n字体高度<" (rtos #H 2 0) ">: "))
   )
   (setq #F NIL)
)
   )
)
(setq #FF #F)
(command "_.text" "j" "C" #F #H "" "符号  序号")
(command "_.text"
      "j"
      "C"
      (polar #F 0 (* #H 7))
      #H
      ""
      "孔径"
)
(command "_.text"
      "j"
      "C"
      (polar #F 0 (* #H 12))
      #H
      ""
      "冲针"
)
(command "_.text"
      "j"
      "C"
      (polar #F 0 (* #H 17))
      #H
      ""
      "数量"
)
(setq #F (polar #F (/ pi -2.0) (* #H 2)))
(setq N 1)
(while (/= (setq DATA (car H_LIST)) NIL)
   (command "_.text"
         "j"
         "c"
         (polar #F 0 (* #H 7))
         #H
         ""
         (strcat "Φ" (rtos (* (car DATA) 2.0) 2 2))
   )
   (command "_.text"
         "j"
         "C"
         (polar #F 0 (* #H 12))
         #H
         ""
         (strcat "Φ" (rtos (* (car DATA) 2.0) 2 2))
   )
   (command "_.text"
         "j"
         "C"
         (polar #F 0 (* #H 17))
         #H
         ""
         (rtos (cadr DATA))
   )
   (command "_.text"
         "j"
         "C"
         (polar #F 0 (* #H 2.5))
         #H
         ""
         (rtos N)
   )
   (command "_.circle"
         (polar #F 0 (* #H -3))
         (car DATA)

   )
   (setq #F (polar #F (/ pi -2.0) (* #H 2)))
   (setq zj (+ zj (cadr DATA)))
   (setq H_LIST (cdr H_LIST))
   (setq N (1+ N))
)
(setq #F (polar #F (/ pi -40.0) (* #H 2)))
(command "_.text"
      "j"
      "C"
      (polar #F 0 (* #H 13.5))
      #H
      ""
      (strcat "总数=" (rtos zj))
)
  )

  (defun MAKE_LIST (/ SS N R_LIST TMP)
(if (setq SS (ssget "X" '((0 . "CIRCLE"))))
   (progn
(setq N 0)
(repeat (sslength SS)
   (if (not (member
      (setq TMP (cdr (assoc 40 (entget (ssname SS N)))))

      R_LIST
   )
      )
      (setq R_LIST (append R_LIST (list TMP)))

   )
   (setq N (1+ N))
)
   )
)
(setq N 0)
(repeat (length R_LIST)
   (setq
TMP (ssget "X"
   (list (cons 0 "CIRCLE") (cons 40 (nth N R_LIST)))
      )
   )
   (setq
R1_LIST (append R1_LIST
(list (list (nth N R_LIST) (sslength TMP)))
)
   )
   (setq N (1+ N))
)
  )

  (setq HOLDECHO (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "_.UNDO" "_GROUP")
  (setq HOLDOSMODE (getvar "OSMODE"))
  (setq HOLDZIN (getvar "DIMZIN"))
  (setvar "DIMZIN" 8)
  (setvar "OSMODE" 0)
  (MAKE_LIST)
  (WRITE_TABLE
(vl-sort R1_LIST
      (function (lambda (E1 E2)
   (< (car E1) (car E2))
         )
      )
)
  )
  (WRITE_LINE)
  (setvar "OSMODE" HOLDOSMODE)
  (setvar "DIMZIN" HOLDZIN)
  (command "_.UNDO" "_END")
  (setvar "CMDECHO" HOLDECHO)
  (princ)
)
;以上是我改了后的圆孔统计表，不知道哪里还要修改不，帮我看看吧。我还改了个单个手工输入半径和块名的程序，这样我就可以把圆代换成块了。
我现在想把二个程序合起来用，不知道能不能实现哪，就是执行完圆孔统计表后自动执行代换程序，把图中所有有的圆孔变成块。下面的是我的单步执行程序。
;单个代换程序。
(defun c:dcb (/ ss CS1 count en p p3 ss1)
  (while (= ss NIL)
(setq p3 0.5)
(initget 1 )
(setq p3 (getreal "\n输入要被代换圆的半径: "))
(setq cs1 (getstring "\n输入代换的块名: "))
(setq ss  (ssget "X"
      (list
         (cons 0 "circle")
         (cons 40 p3)
      )
      )
   idx 0
)
  )
  (command "undo" "BE")
  (setq count 0)
  (while (< count (sslength ss))
(setq en (ssname ss count))
(setq p (cdr (assoc 10 (entget en))))
(entdel en)
(command "-insert" cs1 p "" "" "")
(setq count (1+ count))
  )
  (setq count nil
en nil
p nil
ss nil
cs1 nil
p3 nil
  )
)

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

请陈老师或各位高手帮个忙编个程序(能实现在图低中批量代换图形的功能。)

不太懂啊，能说一下怎么用吗，我不会编程呀。

BLOCK名稱為"1","2","3"....指的是直徑

圓孔統計表>>>

非常感谢，我在努力消化程序。

多谢龙仔，我想再在旁边加一个条目该如何改程序呢。像这个(附效果图)

如何改程序??太簡單,多看點書,我弄好了,但還是讓你自己做比較好!

我晕倒，不是吧，龙仔，我手上没有书呀。我都是看的ACAD的帮助文件，那我自己改着试

我也搞定了，多谢龙大侠指导，帮我看看对不对，哪里还要改不。

加個排序及序號!

本帖子中包含更多资源

龙大虾，我弄好了。不知道能不能帮我帮我把这二个程序加在一起做呢

浏览过的版块