删除该行的更新版本：
- ; Diamond ~ by Lee McDonnel [25.01.2009]
- ; Places a Diamond Block at the Intersection of a LWPolyline
- ; [Assumes Diamond Block Definition is in Drawing]
- ; [updated to remove intersecting line]
- (defun c:diamond (/ ss lEnt eLst sLin eLin pvert i int intLst)
- (vl-load-com)
- (if (and (setq ss (ssget '((0 . "LWPOLYLINE"))))
- (setq lEnt (car (entsel "\nSelect Intersecting Line > ")))
- (eq (cdr (assoc 0 (entget lEnt))) "LINE"))
- (progn
- (setq eLst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
- sLin (cdr (assoc 10 (entget lEnt)))
- eLin (cdr (assoc 11 (entget lEnt))))
- (foreach ent eLst
- (setq pVert (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget ent))))
- (if (eq (setq i (length pVert)) 4)
- (progn
- (while (not (zerop (setq i (1- i))))
- (if (setq int (inters sLin eLin (nth i pVert) (nth (1- i) pVert)))
- (setq intLst (cons int intLst))))
- (setq intLst (vl-sort intLst '(lambda (x1 x2) (< (car x1) (car x2)))))
- (SetBlkTF "3ANSYMB")
- (entmake (list (cons 0 "INSERT") (cons 2 "3ANSYMB") (cons 10 (cadr intLst))))
- (entmake (list (cons 0 "INSERT") (cons 2 "3ANSYMB") (cons 10 (cons (- (caar intLst) 6.5515) (cdar intLst))))))))
- (entdel lEnt))
- (princ "\n<!> No Line Selected, or this isn't a Line! <!>"))
- (princ))
- (defun SetBlkTF (n)
- (cond ((not (snvalid n))
- (princ "\nInvalid Block Name - " n)
- (exit))
- ((tblsearch "BLOCK" n))
- ((findfile (strcat n ".DWG"))
- (command "_.INSERT" n)
- (command))
- (T ; If all else fails....
- (entmake (list (cons 0 "BLOCK") (cons 2 n) (cons 10 (list 0 0 0)) (cons 70 0)))
- (entmake (list (cons 0 "TEXT")
- (cons 1 (strcat "BLOCK PLACECARD - " n))
- (cons 7 (cdr (assoc 2 (tblnext "STYLE" T))))
- (cons 8 "0")
- (cons 10 (list 0 0 0))
- (cons 11 (list 0 0 0))
- (cons 40 (max 1 (getvar "TEXTSIZE")))
- (cons 72 4)))
- (entmake (list (cons 0 "ENDBLK") (cons 8 "0")))))n)
| 
置顶卡
