如何判断文字的内容相同
已有选择集 s1,s2,s1和s2都是文字,
请问如何如何判断s1=s2(文字内容相同)
本帖最后由 llsheng_73 于 2018-1-2 14:20 编辑
(defun COMPAREssTEXT(s1 s2);;两个选择集均全为文字且文字内容相同返回真值T
(and(equal(type s1)'pickset)
(equal(type s2)'pickset)
(setq s1(vl-remove'nil(mapcar'(lambda(x)(if(equal(type(cadr x))'ename)(if(member'(0 . "TEXT")(setq x(entget(cadr x))))(assoc 1 x)x)))(ssnamex s1)))
s2(vl-remove'nil(mapcar'(lambda(x)(if(equal(type(cadr x))'ename)(if(member'(0 . "TEXT")(setq x(entget(cadr x))))(assoc 1 x)x)))(ssnamex s2))))
(vl-every'(lambda(x)(member x s2))s1)
(vl-every'(lambda(x)(member x s1))s2))
)
文字内容是否相同一般根据text图元的内容来判断,很少判断两个选择集的文字是否相同,因为选择集是由图元构成,数量多少不一定,比如s1里边有3个内容为"A1"的文字,s2里边有5个内容为"A1"的文字,内容倒是一样了,该判定为相同还是不同呢? llsheng_73 发表于 2018-1-2 12:00
文字内容是否相同一般根据text图元的内容来判断,很少判断两个选择集的文字是否相同,因为选择集是由图元构 ...
可以视为相同 669423907 发表于 2018-1-2 12:08
可以视为相同
那你把S1 S2的内容都读出来,去掉重复项,判断。 mikewolf2k 发表于 2018-1-2 12:41
那你把S1 S2的内容都读出来,去掉重复项,判断。
不知道要如何写呢 llsheng_73 发表于 2018-1-2 14:13
大师的太深奥了,不会调用啊,还望指点
(defun c:13()
(c:re)
(command "Select" ss "")
(setq s1 (ssget "p" '((8 . "材质4")(0 . "*text"))))
(command "Select" ss "")
(setq s2 (ssget "p" '((8 . "文字")(0 . "*text"))))
(COMPAREssTEXT)
(if (= s2 s1)
(command "erase" s2 "")
(command "erase" s1 "")
)
(princ))
;可见区域重生成(hbllw 2010-11-6)
(defun c:re( / $screen atio ce ch ch2 hh hh2 k p1 p2 sk dim0)
(vlax-invoke (vlax-create-object "wscript.shell")'run "打开数字键盘.vbs")
(qq1)
(setq $screen (getvar "screensize"))
(setq ch (getvar "viewsize"))
(setq ch2 (/ ch 2)) (setq ce (getvar "viewctr"))
(setq atio (/ (car $screen) (cadr $screen)))
(setq hh (* atio ch))
(setq hh2 (/ hh 2))
(setq p1 (polar (polar ce 0 hh2)
(* 1.5 pi) ch2))
(setq p2 (polar (polar ce pi hh2)
(* 0.5 pi) ch2))
(setq sk (ssget "c" p1 p2))
(setq k -1)
(if (and (> (sslength sk) 0)(< (sslength sk) 5001) )
(repeat (sslength sk)
(entupd (ssname sk (setq k (1+ k)))))
(strcat "对象已超过 5000") )
;(command "Select" sk "")
(setq dim0 (ssget "p" '((0 . "dimension") (42 . 0) )))
(if (/= dim0 nil)(progn
(command "erase" dim0 "") ))
(princ)) (defun c:13()
(c:re)
(command "Select" ss "")
(setq s1 (ssget "p" '((8 . "材质4")(0 . "*text"))))
(command "Select" ss "")
(setq s2 (ssget "p" '((8 . "文字")(0 . "*text"))))
(if (COMPAREssTEXT s2 s1)
(command "erase" s2 "")
(command "erase" s1 "")
)
(princ)) 比较简单,希望有所帮助!
(defun C:ss (/ text_1 text_2 v1 v2 vv a)
(setq s1 (ssget '((0 . "TEXT"))))
(setq s2 (ssget '((0 . "TEXT"))))
(setq N1 (sslength s1 ))
(setq N2 (sslength s2 ))
(setq i 0
j 0
text_1 ()
text_2 ())
(while (<= i (1- N1))
(setq name1 (ssname s1 i))
(setq text_0 (assoc 1 (entget name1)))
(setq text_1 (cons text_0 text_1))
(setq i (1+ i))
)
(while (<= j (1- N2))
(setq name1 (ssname s2 j))
(setq text_0 (assoc 1 (entget name1)))
(setq text_2 (cons text_0 text_2))
(setq j (1+ j))
)
(foreach p text_1
(setq v1 (mapcar 'cdr text_1)))
(foreach p text_2
(setq v2 (mapcar 'cdr text_2)))
(setq len1 0)
(while (< len1 (1- (length v1)))
(setq t1 (nth len1 v1))
(setq lst(vl-remove-if '(lambda (x) (= x t1)) (vl-remove t1 v1)))
(setq v1 (cons t1 lst))
(setq len1 (1+ len1))
v1
)
(setq len2 0)
(while (< len2 (1- (length v2)))
(setq t1 (nth len2 v2))
(setq lst(vl-remove-if '(lambda (x) (= x t1)) (vl-remove t1 v2)))
(setq v2 (cons t1 lst))
(setq len2 (1+ len2))
v2
)
(setq v1 (vl-sort v1 '<)
v2 (vl-sort v2 '<)
vv 0
a 0)
(while (< vv (length v1))
(if (= (nth vv v1) (nth vv v2))
(setq a (1+ a))
)
;(princ (strcat "\n 第" (rtos(1+ vv)) "项文字" (nth vv v1) "相同!"))
;(princ "\n 所选文字不相同!"))
(setq vv (1+ vv))
)
(if (= a vv)
(princ "\n 所选文字都相同!")
(princ "\n 所选文字不相同!"))
(princ)
)
页:
[1]