(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
; version 1.3
; added option to read/ignore dashes in text signifying a negative number
; comment out line (if (not GlbVarInvAllowNeg) (setq GlbVarInvAllowNeg t))
; to not read dashes as negative numbers
; corrected issue with trailing period, correctly leaves it now
; version 1.4
; allowed for mtext to be selected, ignoring most of the formatting strings
; but if a number is formatted in the middle of the number, then the number
; will be seen by the program as two numbers. ie 9850, where 98 is one color
; and 50 is another color, they will be read as two numbers by the program
; allowed a List option, when selected which value to change, for it you
; select a long mtext string, you might not know the locations of the
; numeric strings that the program will try and change.
; version 1.5
; allowed for integer based numbers to have zeros added to the prefix to match
; the same string length as the one being adjusted (not counting negative signs),
; ie. '03' + 4 = '07' instead of '7' & '-03' + 4 = '01'
; version 1.6
; retain the entered value for the next time the program is used, first
; use will not have the default option, but all others will

(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 parseString ( aStr aAllowNeg aIsMtext / len pos isNum str tStr lst ctlChrs pos2 )
; returns a list of the supplied string, where each entry
; is separated by being either only alphas or numbers
; aAllowNeg a boolean that allows negative numbers, ie. -90, to have the dash count as a negative number
; aIsMtext a boolean telling the function if the string supplied is an mtext string, for filtering out formatting codes within the string

(setq ctlChrs '( "C" "F" "H" "S" "T" "Q" "W" "A" ))
(setq len (strlen aStr))
(setq pos 1)
(setq str (substr aStr pos 1))
(setq isNum (isPositionNumber aStr pos aAllowNeg))
(while ( "07"
; aStr is the string to add 'aNum' value to
(setq tens (expt 10 (- (strlen aStr) (if (= (substr aStr 1 1) "-") 2 1))))
(setq num (+ (atoi aStr) aNum))
(setq str (itoa num))
(if (< num 0)
(progn
(setq str (substr str 2))
(setq neg T)
)
)
(strcat
(if neg "-" "")
(if ( cnt 1)
(while
(not
(progn
(initget "All, List")
(setq opt
(getint
(strcat
"\n Enter number location to change [1-"
(itoa cnt)
"/List/All] \""
(apply (function strcat) aList)
"\" : "
)
)
)
(if (not opt)
(if (<= 1 aDflt cnt) (setq opt aDflt))
(cond
((= opt "List")
(setq str "")
(setq cnt2 0)
(foreach i aList
(setq str
(strcat
str
"\n"
(if (isPositionNumber i 1 aAllowNeg)
(strcat (itoa (setq cnt2 (+ cnt2 1))) " ")
(strcat " ")
)
i
)
)
)
(prompt str)
)
((or (= opt "All") ( plcs aPlcs) plcs aPlcs))
)
(if (zerop plcs) "." "")
)
(myItoa i aNum)
)
)
)
(setq str (strcat str i))
)
(list str aDflt)
)
;----------------------------------------------------------------------------
(defun getStringNumber ( aMsg aAllowNeg / 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 aAllowNeg))))
flag
)
;--------------------
(setq aMsg
(strcat
"\n"
aMsg
(if GlbVarInvDefault
(strcat " [" GlbVarInvDefault "]: ")
": "
)
)
)
(while
(and
(setq str (getstring aMsg))
(setq str (if (= str "") (if GlbVarInvDefault GlbVarInvDefault "") str))
(/= str "")
(not (checkString str))
)
)
str
)
;-------------------------------------------------------------------------
(defun isPositionNumber ( aStr aPos aAllowNeg / 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
; aAllowNeg a boolean that allows negative numbers, ie. -90, to have the dash count as a negative number
(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 GlbVarInvAllowNeg (= (vla-get-ObjectName obj) "AcDbMText")))
(setq lst (adjustString lst loc num plcs GlbVarInvAllowNeg))
(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