sssetfirst 筛选提取同心圆的大圆和小圆
；；后半部分太复杂，看不太明白,这段程序是删除同心圆大圆，想用sssetfirst函数改成筛选出同心圆大圆和小圆。或者用command "chprop"“LA” “1” 将同心圆放入某层。
(defun c:cdx ( / CNT DATA EN HDL HHH IDX II RRR SS)
(if (setq ii -1
ss (ssget '((0 . "CIRCLE，ARC")))
)
(repeat (sslength ss)
(setq en (ssname ss (setq ii (1+ ii)))
hdl (cdr (assoc 5 (entget en)));;;句柄
cnt (cdr (assoc 10 (entget en)));;圆心坐标
rrr (cdr (assoc 40 (entget en)));;半径
idx (strcat (rtos (car cnt) 2 2) "#" (rtos (cadr cnt) 2 2));;;X#Y
)
(if (null (setq hhh (cdr (assoc idx data))))
(setq data (cons (cons idx hdl) data))
(if (> (cdr (assoc 40 (entget (handent hhh))))
rrr
)
(setq hhh(entdel (handent hhh))
data (subst (cons idx hdl) (assoc idx data) data)
)
(entdel en)
)
)
)
)
)
谢谢各位。
(defun c:tt ()；这是llsheng_73的程序，可以提取同心圆，就是没有对圆心rtos偏差，怎么改呢，刚学习几天还不会改
(setq ss (ssget '((0 . "circle"))))
(if ss
(progn
(setq m (sslength ss)
n 0
)
(while (< n m)
(setq e (ssname ss n)
n (1+ n)
l n
p (assoc 10 (entget e)) ;;用rtos设置容差
P (vl-princ-to-string (list (nth 1 p) (nth 2 p)))
a nil
)
(while (< l m)
(setq f(ssname ss l)
l(1+ l)
p1 (assoc 10 (entget f)) ;;用rtos设置容差
P1 (vl-princ-to-string (list (nth 1 p1) (nth 2 p1)))
)
(if (= p p1)
(progn
(ssdel f ss)
;(entdel f)
(command "layer" "m" 1 "" "change" f "" "p" "la" 1 "")
(setq l (1- l)
m (1- m)
a t
)
)
)
)
(if a
(progn
(ssdel e ss)
；(entdel e)
(command "layer" "m" 1 "" "change" e "" "p" "la" 1 "")
(setq n (1- n)
m (1- m)
)
)
)
)
)
)
) ；已解决。
(defun c:tt ()
(setq ss (ssget '((0 . "circle,arc"))))
(if ss
(progn
(setq m (sslength ss)
n 0
)
(while (< n m)
(setq e (ssname ss n)
n (1+ n)
l n
p (assoc 10 (entget e))
P (vl-princ-to-string (list (nth 1 p) (nth 2 p)))
a nil
)
(while (< l m)
(setq f(ssname ss l)
l(1+ l)
p1 (assoc 10 (entget f))
P1 (vl-princ-to-string (list (nth 1 p1) (nth 2 p1)))
)
(if (equal P P1 2) ;(< (distance P P1) 2)
(progn
(ssdel f ss)
;(entdel f)
(command "layer" "m" 1 "" "change" f "" "p" "la" 1 "")
(setq l (1- l)
m (1- m)
a t
)
)
)
)
(if a
(progn
(ssdel e ss)
;(entdel e)
(command "layer" "m" 1 "" "change" e "" "p" "la" 1 "")
(setq n (1- n)
m (1- m)
)
)
)
)
)
)
) shopping200 发表于 2018-1-27 23:38
；已解决。
(defun c:tt ()
(setq ss (ssget '((0 . "circle,arc"))))
测试好像发现问题：对于圆心测量坐标值Y增加不起作用，Y值减小起作用，同样同心圆的一个圆将其X值减小则不起作用，X值增大可以实现程序的功能。应该改为对圆心点的距离容差吧？怎么改呢？ 哪位大神帮忙看看哪里不对啊 我要批量把外圆改成蓝色 内圆改成红色
(defun c:tt1 ()
(setq ss (ssget '((0 . "circle"))))
(if ss
(progn
(setq m (sslength ss)
n 0
)
(while (< n m)
(setq e (ssname ss n)
n (1+ n)
l n
p (assoc 10 (entget e))
r (cdr (assoc 40 (entget e)))
P (vl-princ-to-string (list (nth 1 p) (nth 2 p)))
a nil
)
(while (< l m)
(setq f(ssname ss l)
l(1+ l)
p1 (assoc 10 (entget f))
rr(cdr (assoc 40 (entget f)))
P1 (vl-princ-to-string (list (nth 1 p1) (nth 2 p1)))
)
(if (equal P P1 20)
(progn
(ssdel f ss)
(if (> r rr )
(progn
(command "change" f "" "p" "c" 40 "")))
(if (< r rr )
(progn
(command "change" f "" "p" "c" 5 "")))
(setq l (1- l)
m (1- m)
a t
)
)
)
)
(if a
(progn
(ssdel e ss)
(if (> r rr )
(progn
(command "change" e "" "p" "c" 5 "")))
(if (< r rr )
(progn
(command "change" e "" "p" "c" 40 "")))
(setq n (1- n)
m (1- m)
)
)
)
)
)
)
)
页:
[1]