;;; T.Willey Routine from: https://www.theswamp.org/index.php?topic=51264.0
(defun SelectText ( message selBit / ProjectPointOnPlane DotProduct DoPointListsIntersect AreAllPointsInside AddToSelectionSet GetTextBoundingBox
GetMTextBoundingBox UpdateEntityList grWindowSelection grPolygonSelection CreateHatch
FltStr AddFlag MessPrmpt tempStr SpStr flag Pt Pt2 GrList Sel tempNum EntType EntData Ent Data EntList tempEntList tempPt tempPt2 tempPt3
SelPat tempPt4 tempPt5 ss tempss1 tempss2 ssData SelCnt EntCnt DupCnt RmvCnt PtList Norm InsPt tempPtList TxPtList LayEnt LayList )

; v1.1 21 Dec 2010 – Added the ability to select with polygon selection also. Now user can select Window / Crossing / Window Polygon / Crossing Polygon
; v1.2 28 Feb 2011 – Added the ability to select attribute definitions.
; v1.3 16 May 2012 – Updated so empty attributes will not be selected.
; v1.4 11 Sept 2012 – Updated so entities on locked/frozen/off layers will not be selected
; v1.5 19 Sept 2012 – Updated selection of attribute definitions
; Lets you select Text / Attribute References / Mtext entities with an ‘ ssget ‘ fashion.
; message = The default message when adding items to the list
; selBit = An integer value, or combination of, that tells the code which type of entities to select.
; 1 = Text
; 2 = Attributes
; 4 = Mtext
; 8 = Attribute Definitions
; ie: a value of 5 will select only Text and Mtext entities.
; Returns a list of selected entity names.
; Thanks again to Gile, for the code posted ( below ), and other posted code that helped when I was lost.

(defun ProjectPointOnPlane (pt dir org nor / scl)
;; ProjectPointOnPlane (gile)
;; Returns the projected point on the specified plane
;;
;; Arguments
;; pt: the point to be projected
;; dir: the projection direction vector
;; org: a point on the projection plane
;; nor: the projection plane normal vector
(if
(and
(not (equal 0. (setq scl (DotProduct nor dir))))
(setq scl (/ (DotProduct nor (mapcar (function -) pt org)) scl))
)
(mapcar (function +) pt (mapcar (function (lambda (x) (* x (- scl)))) dir))
)
)
;——————————————————————-
(defun DotProduct (v1 v2)
;; DotProduct (gile)
;; Returns the dot product (scalar product) of two vectors
;;
;; Arguments : two vectors
(apply (function +) (mapcar (function *) v1 v2))
)
;——————————————————————-
(defun DoPointListsIntersect ( lst1 lst2 / flag cnt MaxCnt cnt2 MaxCnt2 Pt Pt2 )

(setq cnt 0)
(setq MaxCnt (1- (length lst1)))
(setq MaxCnt2 (1- (length lst2)))
(while (<= cnt MaxCnt)
(setq Pt (nth cnt lst1))
(setq Pt2 (nth (if (zerop cnt) MaxCnt (1- cnt)) lst1))
(setq cnt2 0)
(while (<= cnt2 MaxCnt2)
(if
(inters
Pt
Pt2
(nth cnt2 lst2)
(nth (if (zerop cnt2) MaxCnt2 (1- cnt2)) lst2)
)
(setq cnt MaxCnt cnt2 MaxCnt2 flag t)
)
(setq cnt2 (1+ cnt2))
)
(setq cnt (1+ cnt))
)
flag
)
;—————————————————————-
(defun AreAllPointsInside ( lst lst2 / Dist MaxCnt )

(setq Dist (apply (function +) (mapcar (function (lambda ( x ) (apply (function +) (mapcar (function abs) x)))) lst2)))
(setq MaxCnt (1- (length lst2)))
(not
(member
nil
(mapcar
(function
(lambda ( pt / IntCnt cnt Pt2 )
(setq IntCnt 0)
(setq cnt 0)
(setq Pt2 (polar pt 0. Dist))
(while (<= cnt MaxCnt)
(if
(inters
pt
Pt2
(nth cnt lst2)
(nth (if (zerop cnt) MaxCnt (1- cnt)) lst2)
)
(setq IntCnt (1+ IntCnt))
)
(setq cnt (1+ cnt))
)
(equal (rem IntCnt 2) 1)
)
)
lst
)
)
)
)
;—————————————————————-
(defun AddToSelectionSet ( ss1 ss2 / Ent )

(cond
((and ss1 ss2)
(foreach i (ssnamex ss1)
(if (equal (type (setq Ent (cadr i))) 'ENAME)
(setq ss2 (ssadd Ent ss2))
)
)
ss2
)
( ss1 )
( ss2 )
(t nil)
)
)
;——————————————————————-
(defun GetTextBoundingBox ( entData / InsPt Ali Rot Len TxPt TxPt2 TxHt InsDxf )

(if (equal (type entData) 'ENAME) (setq entData (entget entData)))
(setq InsPt (value (setq InsDxf (if (and (zerop (value 72 entData)) (zerop (value (if (= EntType "ATTDEF") 74 73) entData))) 10 11)) entData))
(setq Ali (value 72 entData))
(setq Rot (value 50 entData))
(setq entData (subst '(50 . 0.) (assoc 50 entData) entData))
(setq entData (entget (entupd (value -1 (entmod (subst '(72 . 2) (assoc 72 entData) entData))))))
(setq Len (distance (value 10 entData) (value 11 entData)))
(setq entData (subst (cons 50 Rot) (assoc 50 entData) entData))
(setq entData (subst (cons 72 Ali) (assoc 72 entData) entData))
(setq entData (entget (entupd (value -1 (entmod (subst (cons InsDxf InsPt) (assoc InsDxf entData) entData))))))
(list
(setq TxPt (value 10 entData))
(setq TxPt2 (polar TxPt Rot Len))
(polar TxPt2 (setq Rot (rem (+ (* 0.5 pi) Rot) (* 2. pi))) (setq TxHt (value 40 entData)))
(polar TxPt Rot TxHt)
)
)
;———————————————————————————-
(defun GetMTextBoundingBox ( entData / InsPt Wid Ht AtchNum Rot tempRot tempVec )

(if (equal (type entData) 'ENAME) (setq entData (entget entData)))
(setq InsPt (value 10 entData))
(setq Wid (value 42 entData))
(setq Ht (value 43 entData))
(setq AtchNum (value 71 entData))
(setq Rot
(if (< (length (member (setq tempRot (assoc 50 entData)) entData)) (length (member (setq tempVec (assoc 11 entData)) entData)))
(cdr tempRot)
(angle '(0. 0. 0.) (cdr tempVec))
)
)
(setq InsPt
(polar
(polar
InsPt
(rem (+ Rot (* 1.5 pi)) (* 2. pi))
(cond
((<= 1 AtchNum 3) Ht)
((<= 4 AtchNum 6) (* 0.5 Ht))
(t 0.)
)
)
Rot
(if (equal (setq AtchNum (rem AtchNum 3)) 0)
0.
(/ Wid AtchNum)
)
)
)
(list
InsPt
(setq InsPt (polar InsPt (rem (+ Rot (* 0.5 pi)) (* 2. pi)) Ht))
(setq InsPt (polar InsPt (rem (+ Rot pi) (* 2. pi)) Wid))
(setq InsPt (polar InsPt (rem (+ Rot (* 1.5 pi)) (* 2. pi)) Ht))
)
)
;———————————————————————————
(defun UpdateEntityList ()

(if
(or
(AreAllPointsInside TxPtList tempPtList)
(and
Cross
(or
(DoPointListsIntersect tempPtList TxPtList)
(AreAllPointsInside tempPtList TxPtList)
)
)
)
(if AddFlag
(if (member Ent EntList)
(setq DupCnt (1+ DupCnt))
(progn
(setq EntList (cons Ent EntList))
(setq EntCnt (1+ EntCnt))
)
)
(if (member Ent EntList)
(progn
(foreach i EntList
(if (not (equal i Ent))
(setq tempEntList (cons i tempEntList))
)
)
(setq EntList tempEntList)
(setq tempEntList nil)
(setq RmvCnt (1+ RmvCnt))
(redraw Ent 4)
)
)
)
)
)
;—————————————————————–
(defun grWindowSelection ( pt opt / Pt2 GrList tempPt tempPt2 tempPt3 SelPat tempPt4 tempPt5 )

(princ "\n Select other corner: ")
(while
(and
(not Pt2)
(setq GrList (grread T 5 1))
)
(cond
((equal (car GrList) 5)
(setq tempPt (cadr GrList))
(setq tempPt2 (trans Pt 1 2))
(setq tempPt3 (trans tempPt 1 2))
(setq SelPat
(cond
((= opt "Window")
256
)
((= opt "Cross")
-256
)
(t (if ( (length PtList) 1)
(setq PtList (cdr PtList))
)
(setq tempMess “”)
)
(t (setq tempMess “”))
)
(princ (strcat “\r” SpStr “\r” Mess tempMess))
)
(t
(setq tempMess (strcat tempMess (chr (cadr GrList))))
(princ (strcat “\r” SpStr “\r” Mess tempMess))
)
)
)
((equal (car GrList) 5)
(redraw)
(if (equal (length PtList) 1)
(grvecs (list (if cross -256 256) pt (cadr GrList)))
(progn
(grvecs
(apply
(function append)
(mapcar
(function
(lambda ( a b )
(list (if cross -256 256) a b)
)
)
(cons (cadr GrList) PtList)
(append PtList (list (cadr GrList)))
)
)
)
(if Hat (progn (entdel Hat) (setq Hat nil)))
;(if Clr (if (CreateHatch PtList Clr) (setq Hat (entlast))))
)
)
)
((equal (car GrList) 3)
(redraw)
(if (= tempMess “”)
(setq PtList (cons (cadr GrList) PtList))
)
)
((equal (car GrList) 11)
(cond
((= tempMess “”)
(setq flag nil)
)
((wcmatch “UNDO” (strcase (strcat tempMess “\*”)))
(if (> (length PtList) 1)
(setq PtList (cdr PtList))
)
(setq tempMess “”)
)
(t (setq tempMess “”))
)
(princ (strcat “\r” SpStr “\r” Mess tempMess))
)
)
)
(if Hat (entdel Hat))
PtList
)
;——————————————————————————-
(defun CreateHatch ( ptlist clr )

(entmake
(append
(list
‘(0 . “HATCH”)
‘(100 . “AcDbEntity”)
(cons 62 clr)
‘(100 . “AcDbHatch”)
‘(10 0.0 0.0 0.0)
‘(210 0.0 0.0 1.0)
‘(2 . “SOLID”)
‘(70 . 1)
‘(71 . 0)
‘(91 . 1)
‘(92 . 1)
(cons 93 (length ptList))
)
(apply
(function append)
(mapcar
(function
(lambda ( a b )
(list
(cons 72 1)
(cons 10 a)
(cons 11 b)
)
)
)
ptList
(append (cdr ptList) (list (car ptList)))
)
)
(list
‘(97 . 0)
‘(75 . 0)
‘(76 . 1)
‘(98 . 1)
‘(10 0.0 0.0 0.0)
)
)
)
)
;—————————————————————————————————————–
(setq FltStr
(strcat
(if (equal (logand 1 selBit) 1)
“TEXT,”
“”
)
(if (equal (logand 2 selBit) 2)
“INSERT,ATTRIB,”
“”
)
(if (equal (logand 4 selBit) 4)
“MTEXT,”
“”
)
(if (equal (logand 8 selBit) 8)
“ATTDEF,”
“”
)
)
)
(if
(or
(not message)
(= message “”)
)
(setq message “\nSelect object: “)
)
(while (setq LayEnt (tblnext “layer” (not LayEnt)))
(setq testBit (cdr (assoc 70 LayEnt)))
(if
(or
(equal (logand 1 testBit) 1)
(equal (logand 4 testBit) 4)
(< (cdr (assoc 62 LayEnt)) 0)
)
(setq LayList (cons (cdr (assoc 2 LayEnt)) LayList))
)
)
(setq AddFlag t)
(setq MessPrmpt message)
(setq tempStr "")
(setq SpStr " ")
(setq flag t)
(while flag
(setq Pt nil Pt2 nil SelOpt nil)
(princ MessPrmpt)
(while
(and
(not Pt)
(setq GrList (grread t 4 2))
)
(cond
((equal (car GrList) 3)
(if (= tempStr "")
(setq Pt (cadr GrList))
)
)
((member (car GrList) '(11 25))
(if (= tempStr "")
(progn
(setq flag nil)
(setq Pt t)
)
)
)
((equal (car GrList) 2)
(cond
((member (cadr GrList) '(13 32))
(cond
((= tempStr "")
(setq flag nil)
(setq Pt t)
)
((wcmatch "ADD" (strcase (strcat tempStr "\*")))
(setq tempStr "")
(princ (strcat "\r" SpStr "\r" (setq MessPrmpt message)))
(setq AddFlag t)
)
((wcmatch "REMOVE" (strcase (strcat tempStr "\*")))
(setq tempStr "")
(princ (strcat "\r" SpStr "\r" (setq MessPrmpt "\n Remove objects: ")))
(setq AddFlag nil)
)
((= "CP" (strcase tempStr))
(setq SelOpt "cp")
(setq tempStr "")
(princ (strcat "\r" SpStr "\r Select first point: "))
)
((= "WP" (strcase tempStr))
(setq SelOpt "wp")
(setq tempStr "")
(princ (strcat "\r" SpStr "\r Select first point: "))
)
((= "C" (strcase tempStr))
(setq SelOpt "c")
(setq tempStr "")
(princ (strcat "\r" SpStr "\r Select first point: "))
)
((= "W" (strcase tempStr))
(setq SelOpt "w")
(setq tempStr "")
(princ (strcat "\r" SpStr "\r Select first point: "))
)
(t
(setq tempStr "")
(princ (strcat "\n Not a valid option.\n " MessPrmpt))
)
)
)
(t
(if (member (cadr GrList) '(8))
(setq tempStr (substr tempStr 1 (1- (strlen tempStr))))
(setq tempStr (strcat tempStr (chr (cadr GrList))))
)
(princ (strcat "\r" SpStr "\r " MessPrmpt tempStr))
)
)
)
)
)
(if flag
(if
(and
(setq Sel (nentselp Pt))
(not (member (cdr (assoc 8 (entget (car Sel)))) LayList))
)
(prompt
(strcat
(if
(and
(equal (length Sel) 2)
(setq tempNum (vl-string-search (setq EntType (cdr (assoc 0 (setq Data (entget (setq Ent (car Sel))))))) FltStr))
)
" 1 found"
" 0 found"
)
(if AddFlag
(cond
((member Ent EntList)
" (1 duplicate), "
)
(tempNum
(setq EntList (cons Ent EntList))
(redraw Ent 3)
", "
)
(t
", "
)
)
(if (member Ent EntList)
(progn
(foreach i EntList
(if (not (equal i Ent))
(setq tempEntList (cons i tempEntList))
)
)
(setq EntList tempEntList)
(setq tempEntList nil)
(redraw Ent 4)
" 1 removed, "
)
""
)
)
(itoa (length EntList))
" total"
)
)
(if
(setq ss
(cond
((not SelOpt)
(setq PtList (grWindowSelection Pt nil))
(if ( DupCnt 0)
(strcat ” (” (itoa DupCnt) ” duplicate) “)
“”
)
(if (> RmvCnt 0)
(strcat ” ” (itoa RmvCnt) ” removed “)
“”
)
)
(strcat “, ” (itoa (length EntList)) ” total”)
)
)
(mapcar (function (lambda (x) (redraw x 3))) EntList)
)
)
)
)
)
(foreach x EntList (redraw x 4))
;(mapcar (function (lambda (x) (redraw x 4))) EntList)
EntList
)

(defun c:INV ( / parseString adjustString isPositionNumber getStringNumber
ActDoc num OldStr AttDefOpt lst str pos plcs ents loc )
; Increase numeric values of a text string
; if an attribute, or definition, is selected, you are prompted to
; change either the Tag or the Text value, only once per run
; if more than one numeric value is found, user is prompted to
; enter the location to change with an option for all ( right now
; there is only an option or change one location or all locations )
; version 1.2
; the number of decimal places will be whichever is greater, the user
; supplied amount or the existing text string. ie. user enters 10.00
; text string is 5, the new value will be 15.00

(vl-load-com)

(defun parseString ( aStr / len pos isNum str tStr lst )
; returns a list of the supplied string, where each entry
; is separated by being either only alphas or numbers

(setq len (strlen aStr))
(setq pos 1)
(setq str (substr aStr pos 1))
(setq isNum (isPositionNumber aStr pos))
(while ( cnt 1)
(while
(not
(progn
(initget “All”)
(setq opt (getint (strcat “\r Enter number location to change [All] \”” (apply (function strcat) aList) “\” : “)))
(if (not opt) (setq opt aDflt))
(or (= opt “All”) (and ( plcs aPlcs) plcs aPlcs))
(itoa (+ (atoi i) aNum))
)
)
)
(setq str (strcat str i))
)
(list str aDflt)
)
;—————————————————————————-
(defun getStringNumber ( aMsg / checkString str )
; get string of numbers only, keep asking until only numbers are entered
; or enter is pressed
(defun checkString ( aStr / pos max flag )
; make sure the string only contains valid number characters
(setq pos 0)
(setq max (strlen aStr))
(while (and (<= (setq pos (+ pos 1)) max) (setq flag (isPositionNumber aStr pos))))
flag
)
;——————–
(while
(and
(setq str (getstring aMsg))
(/= str "")
(not (checkString str))
)
)
str
)
;————————————————————————-
(defun isPositionNumber ( aStr aPos / str )
; test to see if the position provided within the string provided
; is a numeric value. if a period is found, it checks to see if
; the proceeding or trailing value is a digit, and if so returns T
(or
( aPos 1) (<= 48 (ascii (substr aStr (- aPos 1) 1)) 57))
(and (< aPos (strlen aStr)) ( aPos 1) (not (<= 48 (ascii (substr aStr (- aPos 1) 1)) 57)))
)
(and (< aPos (strlen aStr)) (vla-object) ents)
(setq OldStr
(if (= (vla-get-ObjectName obj) “AcDbAttributeDefinition”)
(progn
(or
AttDefOpt
(and
(not (initget “Tag tExt”))
(setq AttDefOpt
(cond
((getkword “\n Change [Tag/tExt] string : “))
(t “Tag”)
)
)
)
)
(if (= AttDefOpt “Tag”)
(vla-get-TagString obj)
(vla-get-TextString obj)
)
)
(vla-get-TextString obj)
)
)
(setq lst (parseString OldStr))
(setq lst (adjustString lst loc num plcs))
(setq str (car lst))
(setq loc (cadr lst))
(if (= (vla-get-ObjectName obj) “AcDbAttributeDefinition”)
(if (= AttDefOpt “Tag”)
(vla-put-TagString obj str)
(vla-put-TextString obj str)
)
(vla-put-TextString obj str)
)
)
)
(vla-EndUndoMark ActDoc)
(princ)
)
(C:INV)

Advertisements