Text String AutoNumber (Created by Tharwat 04.03.2015)


(princ "\nNeed to disable WinHEB in order to work with this program\n")
(defun c:TSN (/ s i e)
;;; Text String AutoNumber Created by Tharwat 04.03.2015
;;; Adapted to Hebrew Fonts (like miryl.shx and mirym.shx ...) by Igal Averbuh 2017

(if (setq i (getint "\nSpecify the text start number :"))
(while (and (princ "\n Pick a text :")
(setq s (ssget "_+.:S:E:L" '((0 . "TEXT,MTEXT"))))
)
(entupd
(cdr
(assoc
-1
(entmod
(subst
(cons
1
(strcat (if (< i 10)
(strcat (itoa i))
(itoa i)
)
"/ "
(cdr (assoc 1 (setq e (entget (ssname s 0)))))
)
)
(assoc 1 e)
e
)
)
)
)
)
(setq i (1+ i))
)
)
(princ)
)
(c:tsn)

One Point Leader Mirror across Vertical axis, with Object Snap for selection


; One Point Leader Mirror across Vertical axis, with Object Snap for selection
; Slightly modified by Igal Averbuh 2017 (added option for leader sellection only)
; Based on Kent Cooper's one point Mirror across Vertical axis, with Object Snap for selection

(defun c:MV (/ pt)
(setvar "osmode" 2)

(setq pt (ssget "_:L" '((0 . "LEADER"))))
(princ "\nSelect Mirror Point:")
(setvar "cmdecho" 0)
(setq pt (getpoint))
(command
"_.mirror"
pt ""
"_none" "@"
"_none" "@0,1"
"_yes"
)
(setvar "osmode" 167)
(setvar "cmdecho" 1)
)

Linear Texts and Attributes Interpolation in a Horizontal plan


; Linear Interpolation in a Horizontal plan
; Based on: http://www.autocadproblems.com/2014/09/marking-level-on-plan-autocad.html
; Slightly modified by Igal Averbuh 2017
; Modified by Master Kent Cooper 2017 (added option for Attributes and nested texts)
; Saved from here: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/linear-interpolation-problem/m-p/6962404/highlight/false#M351363
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:hi()

(princ "\nNeed to disable WinHEB in order to work with this program\n")
(defun LayerPurgePrevention (dictName layerNameList / layerEnameList)
(dictremove (namedobjdict) dictName)
(if
(setq layerEnameList
(vl-remove
nil
(mapcar
'(lambda (layerName) (tblobjname "layer" layerName))
layerNameList
)
)
)
(dictadd
(namedobjdict)
dictName
(entmakex
(vl-list*
'(0 . "XRECORD")
'(100 . "AcDbXrecord")
(mapcar
'(lambda (layerEname) (cons 340 layerEname))
layerEnameList
)
)
)
)
)
)
(setvar "cmdecho" 0)
(command "-layer" "m" "000-Interpolate Text Labels" "")

(LayerPurgePrevention "OnsBedrijfLayerPurgePrevention" '("000-Interpolate Text Labels"))

(command "-style" "Igal" "Arial.ttf" "0" "" "" "" "")

(setvar 'textsize
(cond ((getdist (strcat "\nSpecify Text Height : ")))
((getvar 'textsize))
)
)

(setq GL1 (nentsel "\nSelect First Boundary Text Value:"))

(setq Lvl1 (entget (car GL1)))

(setq G_val1 (assoc 1 Lvl1))

(setq GL2 (nentsel "\nSelect Second Boundary Text Value:"))

(setq Lvl2 (entget (car GL2)))

(setq G_Val2 (assoc 1 Lvl2))

(setq p1 (getpoint "Pick Point Range From:"))
(setq d (getdist p1 "Pick Point Range To:"))
(setq d (float d))

(setq slp1 (- (atof(cdr G_val2)) (atof(cdr G_val1))))
(setq slp (/ slp1 d))

(while
(setq Txt_Pnt (getpoint "\nPick on Interpolate Point in Range..:"))
(setq d1 (distance p1 Txt_pnt))
(setq new_lvl (+ (atof(cdr G_val1)) (* d1 slp)))
(setq val1 (rtos new_lvl 2 2))
(command "text" Txt_pnt "" "" val1)
)
)
(c:hi)

Linear Interpolation in a Horizontal plan


; Linear Interpolation in a Horizontal plan
; Based on: http://www.autocadproblems.com/2014/09/marking-level-on-plan-autocad.html
; Slightly modified by Igal Averbuh 2017
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:hi()

(princ "\nNeed to disable WinHEB in order to work with this program\n")
(defun LayerPurgePrevention (dictName layerNameList / layerEnameList)
(dictremove (namedobjdict) dictName)
(if
(setq layerEnameList
(vl-remove
nil
(mapcar
'(lambda (layerName) (tblobjname "layer" layerName))
layerNameList
)
)
)
(dictadd
(namedobjdict)
dictName
(entmakex
(vl-list*
'(0 . "XRECORD")
'(100 . "AcDbXrecord")
(mapcar
'(lambda (layerEname) (cons 340 layerEname))
layerEnameList
)
)
)
)
)
)
(setvar "cmdecho" 0)
(command "-layer" "m" "000-Interpolate Text Labels" "")

(LayerPurgePrevention "OnsBedrijfLayerPurgePrevention" '("000-Interpolate Text Labels"))

(command "-style" "Igal" "Arial.ttf" "0" "" "" "" "")

(setvar 'textsize
(cond ((getdist (strcat "\nSpecify Text Height : ")))
((getvar 'textsize))
)
)

(while (not
(setq GL1 (entsel "\nSelect First Boundary Text Value:"))
))
(setq Lvl1 (entget (car GL1)))

(if (> (length Lvl1) 22)
(setq G_val1 (nth 13 Lvl1))

(setq G_Val1 (nth 11 Lvl1))
)

(while (not
(setq GL2 (entsel "\nSelect Second Boundary Text Value:"))
))
(setq Lvl2 (entget (car GL2)))

(if (> (length Lvl2) 22)
(setq G_val2 (nth 13 Lvl2))

(setq G_Val2 (nth 11 Lvl2))
)

(setq p1 (getpoint "Pick Point Range From:"))
(setq d (getdist p1 "Pick Point Range To:"))
(setq d (float d))

(setq slp1 (- (atof(cdr G_val2)) (atof(cdr G_val1))))
(setq slp (/ slp1 d))

(while
(setq Txt_Pnt (getpoint "\nPick on Interpolate Point in Range..:"))
(setq d1 (distance p1 Txt_pnt))
(setq new_lvl (+ (atof(cdr G_val1)) (* d1 slp)))
(setq val1 (rtos new_lvl 2 3))
(command "text" Txt_pnt "" "" val1)
)
)
(c:hi)

Automatic Coordinate Labeling (Draw Leader with X,Y coordinates in 000-Coordinates Labels layer)


;;; Automatic Coordinate Labeling (Draw Leader with X,Y coordinates in 000-Coordinates Labels layer)
;;; User can define: Leader Arrow Head Size, Coordinates Text Height and Coordinates Text Location
;;; Created by Igal Averbuh 2017
;;;Based on C.Gingerich and Edwin Prakoso Programs.

(defun c:XY (/ txtsz st midpt endpt htxts ang1 ang2 pt1 pt2 scle
arblk tsize)

(princ "\nNeed to disable WinHEB in order to work with this program\n")
(defun LayerPurgePrevention (dictName layerNameList / layerEnameList)
(dictremove (namedobjdict) dictName)
(if
(setq layerEnameList
(vl-remove
nil
(mapcar
'(lambda (layerName) (tblobjname "layer" layerName))
layerNameList
)
)
)
(dictadd
(namedobjdict)
dictName
(entmakex
(vl-list*
'(0 . "XRECORD")
'(100 . "AcDbXrecord")
(mapcar
'(lambda (layerEname) (cons 340 layerEname))
layerEnameList
)
)
)
)
)
)
(setvar "cmdecho" 0)
(command "-layer" "m" "000-Coordinates Labels" "")

(LayerPurgePrevention "OnsBedrijfLayerPurgePrevention" '("000-Coordinates Labels"))

(setvar "cmdecho" 1)

(setq st nil
midpt nil
endpt nil)
(defun *error* (ms)
(setvar "orthomode" *ortho)
(setq tsize (getvar "textsize"))
(princ ms)
(princ)
)
(setvar "cmdecho" 0)
(setq tsize (getvar "textsize"))
(setq *ortho (getvar "orthomode"))
(setq scle (getvar "dimscale"))
(setvar "orthomode" 0)

(setvar 'DIMASZ
(cond ((getdist (strcat "\nSpecify Leader Arrow Head Size : ")))
((getvar 'DIMASZ))
)
)

(setvar 'textsize
(cond ((getdist (strcat "\nSpecify Coordinates Text Height : ")))
((getvar 'textsize))
)
)

(while
(setvar "orthomode" 0)
(setq st (getpoint "\nPick Coordinates Point: "))

(if (= st nil)(exit))
(setq midpt (getpoint st))
(setvar "orthomode" 1)
(if (= midpt nil)(exit))
(setq endpt (getpoint midpt))
(if (= endpt nil)(exit))
(command "leader" st midpt endpt "" "" "n")
(setvar "orthomode" *ortho)

(setq textloc (getpoint "\nPick Coordinates Text Location: "))

(command "-style" "Igal" "Arial.ttf" "0" "" "" "" "")

(setq x (rtos (car st)))
(setq y (rtos (cadr st)))
; (setq ptcoord (strcat "X= " x " " "Y= " y))
(setq ptcoordx (strcat "X= " x))
(setq ptcoordy (strcat "Y= " y))
(command "_.text" "j" "bl" textloc "" "" ptcoordx )
(command "_.text" "" ptcoordy)

)
)
;(c:xy)

Draw quick leader arrow


(defun c:LA (/ _group _dist lastentity p1 p2 ent obj gr coords pt)
;; Draw quick leader arrow
;; Alan J. Thompson, 03.13.11
;; Slightly modified by Igal Averbuh 2017 (added option to Specify Arrow Head Size)
(vl-load-com)

(setvar 'DIMASZ
(cond ((getdist (strcat "\nSpecify Arrow Head Size : ")))
((getvar 'DIMASZ))
)
)

(defun _group (l)
(if (caddr l)
(cons (list (car l) (cadr l) (caddr l)) (_group (cdddr l)))
)
)

(defun _dist (a b) (distance (list (car a) (cadr a)) (list (car b) (cadr b))))

(setq lastentity (entlast))
(if (and (setq p1 (getpoint "\nSpecify first point: "))
(setq p2 (getpoint p1 "\nSpecity next point: "))
(vl-cmdf "_.leader" "_non" p2 "_non" p1 "" "" "_N")
(not (equal lastentity (setq ent (entlast))))
(setq obj (vlax-ename->vla-object ent))
)
(while (eq 5 (car (setq gr (grread T 15 0))))
(redraw)
(grdraw (cadr gr)
(trans (vlax-curve-getClosestPointTo ent (setq pt (trans (cadr gr) 1 0))) 0 1)
3
-1
)
(if
(equal
(last (setq coords (_group (vlax-get obj 'Coordinates))))
(car (vl-sort coords (function (lambda (a b) (< (_dist a pt) (_dist b pt))))))
)
(vlax-put obj 'Coordinates (apply (function append) (reverse coords)))
)
(grdraw (cadr gr) (trans (car coords) 0 1) 1 -1)
)
)
(redraw)
(princ)
)
(c:la)

Kent Cooper Leader Zero Rotation


;;; Leader Zero Rotation

(defun C:LZR ; Kent Cooper Rotate Leader(s) about first Bend, 2nd leg Horizontal
(/ ss ldr pts23 base refang)
(if (setq ss (ssget "_:L" '((0 . "LEADER"))))
(repeat (setq n (sslength ss))
(setq
ldr (ssname ss (setq n (1- n))); Leader entity
pts23 ; defining points 2 & 3
(cdr ; remove first one [arrow point]
(mapcar 'cdr ; remove 10's [leave coordinates only]
(vl-remove-if
'(lambda (x) (/= (car x) 10))
(entget ldr)
); ...remove...
); mapcar
); cdr & pts23
); setq
(command "_.rotate" ldr ""
(setq base (trans (car pts23) 0 1)); (trans)lated from WCS to current UCS
"_reference" (angtos (setq refang (angle base (trans (cadr pts23) 0 1))) 2 8)
(angtos (* (fix (+ (/ refang pi) 0.5)) pi) 2 8); nearer horizontal direction
); command
); repeat
); if
(princ)
); defun
(c:lzr)

Time of When Object was Modified ( Lee Mak approach)


;; Last Modification Logging Utility - Lee Mac
;; Stores the username/date/command as xdata attached to every modified object.
;; Saved from: http://www.cadtutor.net/forum/showthread.php?89950-xdata-to-save-info-who-last-modified-objects&p=615831&viewfull=1#post615831

;; Type 'LASTMODON' to enable modification logging, and 'LASTMODOFF' to disable logging.

;; Type 'LASTMOD' to view the last modification data for an object.

;; Type 'LASTMODCLEAR' to remove the logged modification data for a set of objects.

(setq lastmod:appid "LMAC_lastmod")

(defun c:lastmod ( / ent lst )
(while
(progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect object to view modification data : ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (null ent) nil)
( (null (setq lst (mapcar 'cdr (cdadr (assoc -3 (entget ent (list lastmod:appid)))))))
(princ "\nSelected object does not contain modification data.")
)
( (princ (strcat "\nObject last modified by " (car lst) " at " (cadr lst) " using the " (caddr lst) " command.")))
)
)
)
(princ)
)
(defun c:lastmodclear ( / idx sel )
(if (setq sel (ssget "_:L" (list (list -3 (list lastmod:appid)))))
(repeat (setq idx (sslength sel))
(entmod (append (entget (ssname sel (setq idx (1- idx)))) (list (list -3 (list lastmod:appid)))))
)
)
(princ)
)
(defun c:lastmodon nil
(lastmod:remove)
(vlr-command-reactor "lastmod"
'(
(:vlr-commandwillstart . lastmod:com:start)
(:vlr-commandended . lastmod:com:ended)
(:vlr-commandcancelled . lastmod:com:clear)
(:vlr-commandfailed . lastmod:com:clear)
)
)
(setq lastmod:obj:rtr
(vlr-object-reactor
( (lambda ( sel / idx lst )
(if sel
(repeat (setq idx (sslength sel))
(setq lst (cons (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) lst))
)
)
)
(ssget "_X")
)
"lastmod"
'(
(:vlr-modified . lastmod:obj:modified)
(:vlr-subobjmodified . lastmod:obj:modified)
)
)
)
(regapp lastmod:appid)
(princ "\nObject modification logging enabled.")
(princ)
)
(defun c:lastmodoff nil
(lastmod:remove)
(princ "\nObject modification logging disabled.")
(princ)
)
(defun lastmod:remove nil
(foreach obj (apply 'append (mapcar 'cdr (vlr-reactors :vlr-object-reactor :vlr-command-reactor)))
(if (= "lastmod" (vlr-data obj)) (vlr-remove obj))
)
(setq lastmod:obj:rtr nil
lastmod:entlast nil
lastmod:objlist nil
)
)
(defun lastmod:obj:modified ( obj rtr arg )
(setq lastmod:objlist (cons obj lastmod:objlist))
(princ)
)
(defun lastmod:com:start ( rtr com / tmp )
(setq lastmod:entlast (entlast))
(while (setq tmp (entnext lastmod:entlast))
(setq lastmod:entlast tmp)
)
(princ)
)
(defun lastmod:com:ended ( rtr com / ent obj )
(setq com (strcase (car com))
ent (if lastmod:entlast (entnext lastmod:entlast) (entnext))
)
(foreach obj lastmod:objlist
(lastmod:addxdata (vlax-vla-object->ename obj) com)
)
(while ent
(if (vlax-write-enabled-p (setq obj (vlax-ename->vla-object ent)))
(progn
(lastmod:addxdata ent com)
(vlr-owner-add lastmod:obj:rtr obj)
)
)
(setq ent (entnext ent))
)
(setq lastmod:objlist nil
lastmod:entlast nil
)
(princ)
)
(defun lastmod:clear ( rtr arg )
(setq lastmod:objlist nil
lastmod:entlast nil
)
(princ)
)
(defun lastmod:addxdata ( ent com / enx )
(if (and (= 'ename (type ent))
(setq enx (entget ent))
(not (wcmatch (cdr (assoc 0 enx)) "VERTEX,ATTRIB,SEQEND"))
)
(entmod
(append (entget ent)
(list
(list -3
(list lastmod:appid
(cons 1000 (getvar 'loginname))
(cons 1000 (menucmd "m=$(edtime,0,yyyy-mo-dd hh:mm:ss)"))
(cons 1000 com)
)
)
)
)
)
)
)
(vl-load-com) (princ)