[讨论]计算圆孔数量并标注圆孔大小

wang8091

例如有ABC 3个圆  A 直径10 有5个  B 直径5 有3个   C直径2 有2个

那会显示10个圆 并在直径10的圆上标注A  在角落旁标注A 有5个  直径10  等等 这些 

syk070205

你可以在模型空间里遍历圆对象,就可以自动统计圆的个数。对于圆的标注，可以通过已遍历到的圆对象，识别其圆心、半径(或直径)等属性即可完成标注

前生

(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 px (vl-prin1-to-string px)
;;;     py (vl-prin1-to-string px)
;;;     )
      (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.75)
       )
    )
    (ENTMAKE ELI)
    (princ)
  )
;;;----------------------------------------
  (defun ccw2 ()
    (vl-load-com)
    (SETQ #PP (GETPOINT (list 0 0) "\n 请输入文本的基准点:..."))
    (cwt #pp #hh "所选圆实体的圆心,直径列表__前生<OursCAD@21cn.com>")
    (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)
;;; (if (equal r #r 0.000001)
   (progn
;;;     (setq ed (entget en))
;;;     (entdel en)
;;;     (entmake ed)
     (setq pt (cdr (assoc 10 (entget en))))
;;;     (setq pt (cdr (assoc 10 ed)))
     (setq eli (list (cons 0 "TEXT")
       (cons 7 "HZ")
       (CONS 8 "TXT")
       (CONS 10 PT)
       (CONS 40 #hh)
       (CONS 1 str)
       (CONS 41 0.75)
        )
     )
     (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)
;;;  (c_hz "HZ" 0.7 0 "TXT.SHX" "1.SHX")
  (setq ss (ssget (list (cons 0 "circle,arc"))))
  (if ss
    (ccw1)
    (prompt "\n 未选择到圆实体:..")
  )
  (setq ccw1 nil
 ccw2 nil
  )
  (setq ss  nil
 eli nil
  )
;;;  (prompt (strcat "\n" (getcfg "appdata/tel")))
  (prompt " ___circle.lsp")
  (princ)
)

前生

很久没有来了。

感慨良多。

Hz型自己先建好在用吧。

有问题可以发邮件

ourscad@21cn.com

联络。

AMTONNY

楼上的程序这个SORTLIST1错误

jslxt

嘻嘻嘻嘻嘻嘻行

flytoday

选择对象: 指定对角点: 找到 73 个
选择对象:
; 错误: no function definition: SORTLIST1

至今没学会

flytoday 发表于 2012-4-11 13:41
选择对象: 指定对角点: 找到 73 个
选择对象:
; 错误: no function definition: SORTLIST1

是啊，我运行也是这个样子