这个程序有时会漏选

xyp1964 · 发表于 2016-9-14 22:54:08

;; tt(圆或弧统计);; [url]http://bbs.mjtd.com/thread-173339-1-1.html[/url]
(defun c:tt ()
(setq p4 (getpoint "\n请输入图框左下角: ")
p5 (getcorner p4 "\n请输入图框右上角: ")
p1 (getpoint "\n请输入要统计的左下角: ")
p0 (getcorner p1 "\n请输入要统计的右上角: ")
p3 (getpoint "\n请输入统计文字位置: ")
p8 (getpoint "\n请输入座标放置位置: ")
x1 (car p1)
y1 (cadr p1)
x4 (car p4)
x5 (car p5)
w (- x5 x4)
h (* (/ w 280 1.) 2)
p9 (polar p8 0 (* 4 h))
p10 (polar p8 0 (* 14 h))
p11 (polar p8 0 (* 22 h))
p12 (polar p8 (* 1.5 pi) h)
p13 (polar p11 (* 1.5 pi) h)
)
(command "line" p12 p13 "")
(command "text" "ml" p9 h 0 "X")
(command "text" "ml" p10 h 0 "Y")
(setq txt "ABCDEFGHIJKLMNOPQ"
ss (ssget "w" p1 p0 '((0 . "arc,circle")))
i 1
pt p3
)
(while (and ss (> (sslength ss) 0))
(setq en (ssname ss 0))
(setq end (entget en))
(setq rad (+ (cdr (assoc 40 end)) 0.000))
(setq pci (cdr (assoc 0 end)))
(setq d (rtos (* 2 rad)))
(setq ssa (ssget "w" p1 p0 (list (cons 40 rad) (cons 0 pci))))
(setq nn (sslength ssa))
(setq stxt (substr txt i 1))
(setq m 0)
(setq x 0)
(repeat nn
(setq een (ssname ssa m))
(setq eend (entget een))
(setq cen (cdr (assoc 10 eend)))
(setq xxx (- (+ (car cen)) x1))
(setq yyy (- (+ (cadr cen)) y1))
(setq xxxt (rtos xxx))
(setq yyyt (rtos yyy))
(setq ssb (ssget "x" (list (cons 10 cen))))
(setq nnn (sslength ssb))
(if (= nnn 2)
(progn
(setq f (ssname ssb 0))
(setq g (ssname ssb 1))
(setq fn (entget f))
(setq gn (entget g))
(setq radf (+ (cdr (assoc 40 fn)) 0.000))
(setq radg (+ (cdr (assoc 40 gn)) 0.000))
(setq radma (max radf radg))
(setq radmi (min radf radg))
(setq p2 (polar cen (* 1.75 pi) (+ 4 radma)))
(if (= rad radf)
(setq ss (ssdel g ss))
(setq ss (ssdel f ss))
)
(if (= rad radf)
(setq hn fn)
(setq hn gn)
)
(setq ty (cdr (assoc 0 hn)))
(setq dma (rtos (* 2 radma)))
(setq dmi (rtos (* 2 radmi)))
(if (= ty "CIRCLE")
(setq sssstxt (strcat " %%c" dma "<CB>"))
(setq sssstxt (strcat " M" dma))
)
(setq ssstxt (strcat "-%%C" dmi "<THR>" sssstxt))
)
(setq p2 (polar cen (* 1.75 pi) (+ 3 rad))
ssstxt (strcat "-%%C" (rtos (* 2 rad) 2 3) "<THR>")
)
)
(setq x (+ 1 x))
(setq xt (itoa x))
(setq xtxt (strcat stxt xt))
(setq xxxxt (strcat xtxt ":"))
(command "text" "ml" p2 h 0 xtxt)
(setq p8 (polar p8 (* 1.5 pi) (* 2 h)))
(setq p9 (polar p9 (* 1.5 pi) (* 2 h)))
(setq p10 (polar p10 (* 1.5 pi) (* 2 h)))
(setq p11 (polar p11 (* 1.5 pi) (* 2 h)))
(command "line"
(polar p8 (* 1.5 pi) h)
(polar p11 (* 1.5 pi) h)
""
)
(command "text" "ml" p8 h 0 xxxxt)
(command "text" "ml" p9 h 0 xxxt)
(command "text" "ml" p10 h 0 yyyt)
(setq ss (ssdel een ss))
(setq m (+ 1 m))
)
(setq sstxt (strcat stxt " : " (itoa nn) ssstxt))
(command "text" "ml" pt h 0 sstxt)
(setq i (+ i 1))
(setq pt (polar pt (* 1.5 pi) (* 1.5 h)))
)
(princ)
)

;; tt(圆或弧统计);; [url]http://bbs.mjtd.com/thread-173339-1-1.html[/url] 
(defun c:tt () 
  (setq        p4  (getpoint "\n请输入图框左下角: ") 
        p5  (getcorner p4 "\n请输入图框右上角: ") 
        p1  (getpoint "\n请输入要统计的左下角: ") 
        p0  (getcorner p1 "\n请输入要统计的右上角: ") 
        p3  (getpoint "\n请输入统计文字位置: ") 
        p8  (getpoint "\n请输入座标放置位置: ") 
        x1  (car p1) 
        y1  (cadr p1) 
        x4  (car p4) 
        x5  (car p5) 
        w   (- x5 x4) 
        h   (* (/ w 280 1.) 2) 
        p9  (polar p8 0 (* 4 h)) 
        p10 (polar p8 0 (* 14 h)) 
        p11 (polar p8 0 (* 22 h)) 
        p12 (polar p8 (* 1.5 pi) h) 
        p13 (polar p11 (* 1.5 pi) h) 
  ) 
  (command "line" p12 p13 "") 
  (command "text" "ml" p9 h 0 "X") 
  (command "text" "ml" p10 h 0 "Y") 
  (setq        txt "ABCDEFGHIJKLMNOPQ" 
        ss  (ssget "w" p1 p0 '((0 . "arc,circle"))) 
        i   1 
        pt  p3 
  ) 
  (while (and ss (> (sslength ss) 0)) 
    (setq en (ssname ss 0)) 
    (setq end (entget en)) 
    (setq rad (+ (cdr (assoc 40 end)) 0.000)) 
    (setq pci (cdr (assoc 0 end))) 
    (setq d (rtos (* 2 rad))) 
    (setq ssa (ssget "w" p1 p0 (list (cons 40 rad) (cons 0 pci)))) 
    (setq nn (sslength ssa)) 
    (setq stxt (substr txt i 1)) 
    (setq m 0) 
    (setq x 0) 
     (repeat nn 
      (setq een (ssname ssa m)) 
      (setq eend (entget een)) 
      (setq cen (cdr (assoc 10 eend))) 
      (setq xxx (- (+ (car cen)) x1)) 
      (setq yyy (- (+ (cadr cen)) y1)) 
      (setq xxxt (rtos xxx)) 
      (setq yyyt (rtos yyy)) 
      (setq ssb (ssget "x" (list (cons 10 cen)))) 
      (setq nnn (sslength ssb)) 
      (if (= nnn 2) 
        (progn 
          (setq f (ssname ssb 0)) 
          (setq g (ssname ssb 1)) 
          (setq fn (entget f)) 
          (setq gn (entget g)) 
          (setq radf (+ (cdr (assoc 40 fn)) 0.000)) 
          (setq radg (+ (cdr (assoc 40 gn)) 0.000)) 
          (setq radma (max radf radg)) 
          (setq radmi (min radf radg)) 
          (setq p2 (polar cen (* 1.75 pi) (+ 4 radma))) 
          (if (= rad radf) 
            (setq ss (ssdel g ss)) 
            (setq ss (ssdel f ss)) 
          ) 
          (if (= rad radf) 
            (setq hn fn) 
            (setq hn gn) 
          ) 
          (setq ty (cdr (assoc 0 hn))) 
          (setq dma (rtos (* 2 radma))) 
          (setq dmi (rtos (* 2 radmi))) 
          (if (= ty "CIRCLE") 
            (setq sssstxt (strcat " %%c" dma "<CB>")) 
            (setq sssstxt (strcat " M" dma)) 
          ) 
          (setq ssstxt (strcat "-%%C" dmi "<THR>" sssstxt)) 
        ) 
        (setq p2     (polar cen (* 1.75 pi) (+ 3 rad)) 
              ssstxt (strcat "-%%C" (rtos (* 2 rad) 2 3) "<THR>") 
        ) 
      ) 
      (setq x (+ 1 x)) 
      (setq xt (itoa x)) 
      (setq xtxt (strcat stxt xt)) 
      (setq xxxxt (strcat xtxt ":")) 
      (command "text" "ml" p2 h 0 xtxt) 
      (setq p8 (polar p8 (* 1.5 pi) (* 2 h))) 
      (setq p9 (polar p9 (* 1.5 pi) (* 2 h))) 
      (setq p10 (polar p10 (* 1.5 pi) (* 2 h))) 
      (setq p11 (polar p11 (* 1.5 pi) (* 2 h))) 
      (command "line" 
               (polar p8 (* 1.5 pi) h) 
               (polar p11 (* 1.5 pi) h) 
               "" 
      ) 
      (command "text" "ml" p8 h 0 xxxxt) 
      (command "text" "ml" p9 h 0 xxxt) 
      (command "text" "ml" p10 h 0 yyyt) 
      (setq ss (ssdel een ss)) 
      (setq m (+ 1 m)) 
    ) 
     (setq sstxt (strcat stxt " : " (itoa nn) ssstxt)) 
    (command "text" "ml" pt h 0 sstxt) 
    (setq i (+ i 1)) 
    (setq pt (polar pt (* 1.5 pi) (* 1.5 h))) 
  ) 
  (princ) 
)

皇上快溜 · 发表于 2016-9-14 23:12:49

本帖最后由皇上快溜于 2016-9-14 23:16 编辑

态感谢xyp1964了，这么长的代码，幸苦你了。因为网页有点问题，没法引用你的帖子回复你。

程序还是有点问题，统计到第二种r值的圆弧，就不再往下统计

我觉得可就跟圆弧有关，它有个识别螺纹的功能，270度圆弧那种，，，，(setq sssstxt (strcat " M" dma)

我试图从这里(setq sssstxt (strcat " M" dma)往上找，找不出关键函数在哪里

wen1235 · 发表于 2016-9-18 14:44:41

(defun c:tjj ()
 (setvar "cmdecho" 0)
 (setvar "osmode" 1)
 (command "osnapcoord" 2)
 (command "ucs" "w")
 ;(command "layer" "s" "txt" "");; 没有这个层就去掉吧
;;; (setq p4 (getpoint "\n 请输入图框左下角:")) 只是为了取字高可以和P1 P0共用减少操作吧
;;; (setq p5 (getpoint "\n 请输入图框右上角:"))
 (setq p1 (getpoint "\n 请输入图框左下角:"))
 (setq x1 (car p1)
y1 (cadr p1)
 )
 (setq p0 (getcorner p1 "\n 请输入图框右上角:"));;;可以用这个带有特效的
 (setq p3 (getpoint "\n 请输入统计文字位置:"))
 (setq x4 (car p1);;;;
x5 (car p0);;;;
 )
 (setq w (- x5 x4))
 (setq h (* (/ w 280) 2))
;;; (setq p8 (getpoint "\n 请输入座标放置位置:")) 也是为了减少操作
 (setq p8 (polar p3 0.06 80))
 (setq p9 (polar p8 0 (* 4 h)))
 (setq p10 (polar p8 0 (* 14 h)))
 (setq p11 (polar p8 0 (* 22 h)))
 (setq p12 (polar p8 (* 1.5 pi) h))
 (setq p13 (polar p11 (* 1.5 pi) h))
 (setvar "osmode" 0);;
 (command "line" p12 p13 "");; 语法多了 ""
 (command "text" "ml" p9 h 0 "X")
 (command "text" "ml" p10 h 0 "Y")
 (setq txt "ABCDEFGHIJKLMNOPQ")
 (setq ss (ssget "w" p1 p0 '((0 . "circle"))));;;单个弧不再处理
 (setq i 1)
 (setq pt p3)
 (while (> (sslength ss) 0)
(setq en (ssname ss 0))
(setq end (entget en))
(setq rad (cdr (assoc 40 end)));;;
(setq pci (cdr (assoc 0 end)))
(setq d (rtos (* 2 rad) 2));;; 不加指定的话可以出意外啊下面也一样
(setq ssa (ssget "w" p1 p0 (list (cons 40 rad) (cons 0 pci))))
(setq nn (sslength ssa))
(setq stxt (substr txt i 1))
(setq m 0)
(setq x 0)
(repeat nn
 (setq een (ssname ssa m))
 (setq eend (entget een))
 (setq cen (cdr (assoc 10 eend)))
;;; (setq xxx (- (+ 0.000 (car cen)) x1))
;;; (setq yyy (- (+ 0.000 (cadr cen)) y1))
 (setq xxx (- (car cen) x1))
 (setq yyy (- (cadr cen) y1))
 (setq xxxt (rtos xxx 2));;;
 (setq yyyt (rtos yyy 2));;;
 (setq ssb (ssget "w" p1 p0 (list (cons 10 cen))))
 (setq nnn (sslength ssb))
 (if (= nnn 2)
(progn (setq f (ssname ssb 0))
 (setq g (ssname ssb 1))
 (setq fn (entget f))
 (setq gn (entget g))
;;; (setq radf (+ (cdr (assoc 40 fn)) 0.000))
;;; (setq radg (+ (cdr (assoc 40 gn)) 0.000))
 (setq radf (cdr (assoc 40 fn)))
 (setq radg (cdr (assoc 40 gn)))
 (setq radma (max radf radg))
 (setq radmi (min radf radg))
 (setq p2 (polar cen (* 1.75 pi) (+ 4 radma)))
 (if (= rad radf)
 (setq ss (ssdel f ss));;上下调换
 (setq ss (ssdel g ss));;
 )
 (if (= rad radf)
 (setq hn gn);;上下调换
 (setq hn fn);;
 )
 (setq ty (cdr (assoc 0 hn)))
 (setq dma (rtos (* 2 radma) 2 0));;;消零
 (setq dmi (rtos (* 2 radmi) 2));;;;
 (if (= ty "CIRCLE")
 (setq sssstxt (strcat " %%c" dma "<CB>"))
 (setq sssstxt (strcat " M" dma))
 )
 (setq ssstxt (strcat "-%%C" dmi "<THR>" sssstxt))
)
(setq p2 (polar cen (* 1.75 pi) (+ 3 rad))
 ssstxt (strcat "-%%C" (rtos (* 2 rad) 2 3) "<THR>")
 ss (ssdel een ss);;; D
)
 )
 (setq x (+ x 1));;;语法
 (setq xt (itoa x))
 (setq xtxt (strcat stxt xt))
 (setq xxxxt (strcat xtxt ":"))
 (command "text" "ml" p2 h 0 xtxt)
 (setq p8 (polar p8 (* 1.5 pi) (* 2 h)))
 (setq p9 (polar p9 (* 1.5 pi) (* 2 h)))
 (setq p10 (polar p10 (* 1.5 pi) (* 2 h)))
 (setq p11 (polar p11 (* 1.5 pi) (* 2 h)))
 (command "line" (polar p8 (* 1.5 pi) h) (polar p11 (* 1.5 pi) h) "");;语法多了 ""
 (command "text" "ml" p8 h 0 xxxxt)
 (command "text" "ml" p9 h 0 xxxt)
 (command "text" "ml" p10 h 0 yyyt)
 ;;;(setq ss (ssdel een ss)) D 放到上面去
 (setq m (1+ m));;;语法
)
(setq sstxt (strcat stxt " : " (itoa nn) ssstxt))
(command "text" "ml" pt h 0 sstxt)
(setq i (1+ i));;;语法
(setq pt (polar pt (* 1.5 pi) (* 1.5 h)))
 )
 (setvar "osmode" 7)
 (princ);;;没见过这函数，自定义的吗?
)
都是搞模具的给你改了拿去看看效果吧

皇上快溜 · 发表于 2016-9-18 20:53:21

wen1235 发表于 2016-9-18 14:44
(defun c:tjj ()
(setvar "cmdecho" 0)
(setvar "osmode" 1)

高!不胜感激，我慢慢观摩一下先

皇上快溜 · 发表于 2016-9-18 22:51:46

wen1235 发表于 2016-9-18 14:44
(defun c:tjj ()
(setvar "cmdecho" 0)
(setvar "osmode" 1)

你好，同心圆会重复统计，请问改哪里，谢谢

革天明 · 发表于 2016-9-19 07:38:08

Sylvanas 发表于 2016-9-14 16:05
并没有漏选，(ssget "w") 和 (ssget "c") 只能选当前显示范围内的图元，应该是缩放导致显示不完整

解 ...

正解，已经说的很清楚了
①视野范围内才可选中
②ssget参数C与W的区别

皇上快溜 · 发表于 2016-9-19 20:53:08

革天明发表于 2016-9-19 07:38
正解，已经说的很清楚了
①视野范围内才可选中
②ssget参数C与W的区别

你好，我多次在视野范围内点选，仍出问题，是我理解和表述有误，，，原程序选取动作是没有问题的，单是它一遇到圆弧就出出错，不再往下统计。13的程序完善了这一问题，但是又产生了新问题，同心圆重复统计，即同一圆心上的两个圆，各自有一个不同的编码，想请你帮我看看哪里改一下可以解决这一问题，谢谢

革天明 · 发表于 2016-9-20 14:56:43

皇上快溜发表于 2016-9-19 20:53
你好，我多次在视野范围内点选，仍出问题，是我理解和表述有误，，，原程序选取动作是没有问题的，单是它 ...

能否上传dwg进行测试，你给出想要的结果

皇上快溜 · 发表于 2016-9-20 16:11:24

革天明发表于 2016-9-20 14:56
能否上传dwg进行测试，你给出想要的结果

皇上快溜 · 发表于 2016-9-20 16:12:39

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

[提问] 这个程序有时会漏选

本帖子中包含更多资源