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

wujin

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

  (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 zjj (append zjj (list (car DATA))))
    )
    (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))
    )
  )
                                       
  (defun dcb (/ ss1 CS1 count en p F p3)
    (setq F 1)
    (while (/= zjj NIL)
      (setq p3 (car zjj))
      (setq ss1        (ssget "X"
                       (list
                         (cons 0 "circle")
                         (cons 40 p3)
                       )
                )
      )

      (command "undo" "BE")
      (setq count 0)
      (setq cs1 (strcat "h" (rtos F) ".DWG"))
      (while (< count (sslength ss1))
        (setq en (ssname ss1 count))
        (setq p (cdr (assoc 10 (entget en))))
        (entdel en)
        (command "-insert" cs1 p "" "" "")
        (setq count (1+ count))
      )
      (setq F (1+ F))
      (setq zjj (cdr zjj))
    )
  )
  (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)
  (dcb)
  (setvar "OSMODE" HOLDOSMODE)
  (setvar "DIMZIN" HOLDZIN)
  (command "_.UNDO" "_END")
  (setvar "CMDECHO" HOLDECHO)
  (princ)
)

图中代换程序中p3为半径，cs1为块名。我设定的是h1,h2,h3.....

前生

(defun c:cw ()
;;;----------------------------------------
  (defun cwt1 ()
    (setq m 0)
    (repeat (length lisx)
      (setq ps (nth m lisx))
      (setq m (1+ m))
      (setq px (vl-prin1-to-string (car ps))
            py (vl-prin1-to-string (Cadr ps))
      )
      (setq str         (strcat "X坐标为:.." px)
            str1 (strcat "Y坐标为:.." py)
      )
      (cwt #pp #hh str)
      (cwt (POLAR #pp 0.0 (* #hh 15.0)) #hh str1)
      (setq #pp (polar #pp (* pi 1.5) (+ 1.5 #hh)))
    )
    (setq m    nil
          ps   nil
          px   nil
          py   nil
          str  nil
          str1 nil
    )
  )
;;;----------------------------------------
  (defun cwt (#pt #hh txt1)
    (if        (tblsearch "style" "hz")
      (SETVAR "TEXTSTYLE" "hz")
      (progn
        (command "-style" "hz" "txt,xc02" "" "0.7" "" "" "")
        (SETVAR "TEXTSTYLE" "hz")
      )
    );;设置汉字型
    (setq #pt (trans #pt 1 0))
    (setq eli (list (cons 0 "TEXT")
                    (cons 7 "HZ")
                    (CONS 8 "TXT")
                    (CONS 10 #PT)
                    (CONS 40 #hh)
                    (CONS 1 TXT1)
                    (CONS 41 0.5)
              )
    )
    (ENTMAKE ELI)
    (princ)
  )
;;;----------------------------------------
  (defun ccw2 ()
    (vl-load-com)
    (SETQ #PP (GETPOINT (list 0 0) "\n 请输入文本的基准点:..."))
    (cwt #pp #hh "所选圆实体的圆心,直径列表__<OursCAD>")
    (setq #pp (polar #pp (* pi 1.5) (+ 2.5 #hh)))
    (setq n 0)
    (repeat (length lisr)
      (setq r (nth n lisr))
      (setq n (1+ n))
      (setq count 0)
      (setq lisx nil)
      (setq str        (strcat        "圆 C"
                        (rtos n 2 0)
                        " 列表, 直径为:__"
                        (vl-prin1-to-string (* 2.0 r))
                )
      )
      (cwt #pp #hh str)
      (setq #pp (polar #pp (* pi 1.5) (+ 2.5 #hh)))
      (while (< count (sslength ss))
        (setq en (ssname ss count))
        (setq count (1+ count))
        (setq #r (cdr (assoc 40 (entget en))))
        (if (= r #r)
          (progn
            (setq p (trans (cdr (assoc 10 (entget en))) 0 1))
            (setq lisx (cons p lisx))
          )
        )                                ;end of if
      )                                        ;end of while
      (cwt1)
    )
    (setq n nil
          r nil
          count        nil
          lisx nil
          str nil
          en nil
          #r nil
          p nil
    )
    (setq cwt1 nil
          #pp  nil
          #hh  nil
          str  nil
    )
    (princ)
  )
;;;----------------------------------------
  (defun ccw1 ()
    (setq count 0)
    (setq lisr nil)
    (setq #hh nil)
    (while (< count (sslength ss))
      (setq en (ssname ss count))
      (setq r (cdr (assoc 40 (entget en))))
      (setq lisr (cons r lisr))
      (setq count (1+ count))
    )
    (setq en nil
          r nil
          count        nil
    )
    (setq lisr (vl-sort lisr '<))
    (setq lisr (sortlist1 lisr))
    (IF        (NULL
          (sETQ #HH (GETDIST "\n 请输入文本的高度<缺省高度为2.5MM>:.."))
        )
      (SETQ #HH 2.5)
    )
    (setq n 0)
    (repeat (length lisr)
      (setq r (nth n lisr))
      (setq n (1+ n))
      (setq count 0)
      (while (< count (sslength ss))
        (setq en (ssname ss count))
        (setq count (1+ count))
        (setq str (strcat "C" (rtos n 2 0)))
        (setq #r (cdr (assoc 40 (entget en))))
        (if (= r #r)
          (progn
            (setq pt (cdr (assoc 10 (entget en))))
            (setq eli (list (cons 0 "TEXT")
                            (CONS 8 "TXT")
                            (CONS 10 PT)
                            (CONS 40 #hh)
                            (CONS 1 str)
                            (CONS 41 0.5)
                      )
            )
            (ENTMAKE ELI)
            (princ)
          )
        )                                ;end of if
      )                                        ;end of while
    )
    (setq count        nil
          en nil
          r nil
          n nil
          str nil
          pt nil
          eli nil
    )
    (Ccw2)
  )
;;;----------------------------------------
  (setq ss nil)
  (setq ss (ssget (list (cons 0 "circle"))))
  (if ss
    (ccw1)
    (prompt "\n 未选择到圆实体:..")
  )
  (setq        ccw1 nil
        ccw2 nil
  )
  (setq        ss  nil
        eli nil
  )
  (prompt " ___cw.lsp")
  (PRINC)

  (princ)
)

liushaobo

高手能否按此附件完善，完善后请发此邮箱，本人万分感谢  !                                     E-mail:6300900@163.com

quark

顶

linheyuanpcb

翻一下旧的出来，

帮忙改正下只对当前所见的圆有效而不是所有圆都有圆，保留圆,只插入块，

谢谢