|
;;; 一个简单的对图工具,同一dwg内两张图纸不同之处亮显(有修改的地方)。仅支持直线/多段线/圆/圆弧/单行文本/标注。
;;;不是太完美,将就着用巴。
(defun c:dt (/ arc1 arc2 ent i j ls1 ls2 lst na name pc pd pt pt1 pt2 s1 s2 ss ss0 ss1 ss2 ssarc1 ssarc2 sscir1 sscir2
ssdim1 ssdim2 ssline1 ssline2 sslw1 sslw2 sstex1 sstex2 ty x
)
(defun draw (ss i / j) ; 亮显子函数
(repeat (setq j (sslength ss))
(redraw (ssname ss (setq j (1- j))) i)
)
)
(defun db (s1 s2 ss / i j ls1 ls2 na pd) ; 对比子函数
(repeat (setq i (length s1))
(setq ls1 (nth (setq i (1- i))
s1
)
)
(setq pd nil)
(repeat (setq j (length s2))
(setq ls2 (nth (setq j (1- j))
s2
)
)
(if (equal (cdr ls1) (cdr ls2) 0.00001)
(setq pd t
na ls2
)
)
)
(if pd
(setq s2 (vl-remove na s2))
(setq ss (ssadd (car ls1) ss))
)
)
(repeat (setq j (length s2))
(setq ss (ssadd (car (nth (setq j (1- j))
s2
)
) ss
)
)
)
ss
)
(defun ja (pt) ; 将点去掉z坐标
(list (car pt) (cadr pt))
)
(defun js (pt pc) ; 将点减掉基点差
(list (- (car pt) (car pc)) (- (cadr pt) (cadr pc)))
)
(vl-load-com)
(setvar "cmdecho" 0)
(princ "\n选择第一张图:")
(if (setq ss1 (ssget ":S" '((0 . "LINE,CIRCLE,ARC,TEXT,LWPOLYLINE,DIMENSION"))))
(progn
(draw ss1 3)
(if (setq pt1 (getpoint "\n指定第一张图基点:"))
(progn
(draw ss1 4)
(princ "\n选择第二张图:")
(if (setq ss2 (ssget ":S" '((0 . "LINE,CIRCLE,ARC,TEXT,LWPOLYLINE,DIMENSION"))))
(progn
(draw ss2 3)
(if (setq pt2 (getpoint "\n指定第二张图基点:"))
(progn
(setq ss0 (ssadd))
(draw ss2 4)
(setq pc (list (- (car pt2) (car pt1)) (- (cadr pt2) (cadr pt1))))
(repeat (setq i (sslength ss1))
(setq ent (entget (setq name (ssname ss1 (setq i (1- i))))))
(setq ty (cdr (assoc 0 ent)))
(cond
((= ty "LINE")
(setq ssline1 (cons (list name (ja (cdr (assoc 10 ent))) (ja (cdr (assoc 11 ent)))) ssline1))
)
((= ty "CIRCLE")
(setq sscir1 (cons (list name (ja (cdr (assoc 10 ent))) (cdr (assoc 40 ent))) sscir1))
)
((= ty "ARC")
(setq ssarc1 (cons (list name (ja (cdr (assoc 10 ent))) (cdr (assoc 40 ent)) (cdr (assoc 50 ent))
(cdr (assoc 51 ent))
) arc1
)
)
)
((= ty "TEXT")
(setq sstex1 (cons (list name (ja (cdr (assoc 10 ent))) (cdr (assoc 1 ent))) sstex1))
)
((= ty "LWPOLYLINE")
(setq ls1 (mapcar
'cdr
(vl-remove-if-not '(lambda (x)
(= (car x) 10)
) ent
)
)
)
(setq ls1 (cons name (cons (cdr (assoc 70 ent)) ls1)))
(setq sslw1 (cons ls1 sslw1))
)
((= ty "DIMENSION")
(if (/= (cdr (assoc 1 ent)) nil)
(setq x (cdr (assoc 1 ent)))
(setq x (cdr (assoc 42 ent)))
)
(if (member (cdr (assoc 100 (reverse ent))) '("AcDbDiametricDimension" "AcDbRadialDimensio"))
(setq ssdim1 (cons (list name x (ja (cdr (assoc 10 ent))) (ja (cdr (assoc 11 ent)))) ssdim1))
(setq ssdim1 (cons (list name x (ja (cdr (assoc 10 ent))) (ja (cdr (assoc 11 ent)))
(ja (cdr (assoc 13 ent))) (ja (cdr (assoc 14 ent)))
) ssdim1
)
)
)
)
)
)
(repeat (setq i (sslength ss2))
(setq ent (entget (setq name (ssname ss2 (setq i (1- i))))))
(setq ty (cdr (assoc 0 ent)))
(cond
((= ty "LINE")
(setq ssline2 (cons (list name (js (cdr (assoc 10 ent)) pc) (js (cdr (assoc 11 ent)) pc)) ssline2))
)
((= ty "CIRCLE")
(setq sscir2 (cons (list name (js (cdr (assoc 10 ent)) pc) (cdr (assoc 40 ent))) sscir2))
)
((= ty "ARC")
(setq ssarc2 (cons (list name (js (cdr (assoc 10 ent)) pc) (cdr (assoc 40 ent)) (cdr
(assoc 50
ent
)
) (cdr
(assoc 51 ent)
)
) arc2
)
)
)
((= ty "TEXT")
(setq sstex2 (cons (list name (js (cdr (assoc 10 ent)) pc) (cdr (assoc 1 ent))) sstex2))
)
((= ty "LWPOLYLINE")
(setq ls1 (mapcar
'cdr
(vl-remove-if-not '(lambda (x)
(= (car x) 10)
) ent
)
)
)
(setq ls2 '())
(foreach i ls1
(setq ls2 (cons (js i pc) ls2))
)
(setq ls2 (reverse ls2))
(setq ls2 (cons name (cons (cdr (assoc 70 ent)) ls2)))
(setq sslw2 (cons ls2 sslw2))
)
((= ty "DIMENSION")
(if (/= (cdr (assoc 1 ent)) nil)
(setq x (cdr (assoc 1 ent)))
(setq x (cdr (assoc 42 ent)))
)
(if (member (cdr (assoc 100 (reverse ent))) '("AcDbDiametricDimension" "AcDbRadialDimensio"))
(setq ssdim2 (cons (list name x (js (cdr (assoc 10 ent)) pc) (js (cdr (assoc 11 ent)) pc))
ssdim2
)
)
(setq ssdim2 (cons (list name x (js (cdr (assoc 10 ent)) pc) (js (cdr (assoc 11 ent)) pc)
(js (cdr (assoc 13 ent)) pc) (js (cdr (assoc 14 ent)) pc)
) ssdim2
)
)
)
)
)
)
(setq ss0 (db ssline1 ssline2 ss0)) ; 对比直线
(setq ss0 (db sscir1 sscir2 ss0)) ; 对比圆
(setq ss0 (db ssarc1 ssarc2 ss0)) ; 对比圆弧
(setq ss0 (db sstex1 sstex2 ss0)) ; 对比文字
(setq ss0 (db sslw1 sslw2 ss0)) ; 对比多段线
(setq ss0 (db ssdim1 ssdim2 ss0)) ; 对比标注
(if (< (sslength ss0) 100) ; 两图不同之处小于100个夹点亮显,大于则普通亮显
(sssetfirst nil ss0)
(draw ss0 3)
)
)
)
)
)
)
)
)
)
(princ)
) |
|