(defun c:T_export(/ *error* file sset ename lst i p string)
(vl-load-com)
(defun *error* (s)
(if file (close file))
(cond
( ( not s ) )
( (member s '("Function cancelled" "quit / exit abort") ) )
( (princ (strcat "\n---->Error:" s) ) )
)
(princ))
(if (setq sset (ssget "_:L" '((0 . "TEXT,MTEXT"))))
(progn
(if (setq file (open (strcat (getvar 'dwgprefix) "Text Coordinates.csv") "w"))
(progn
(write-line (strcat "String Name" "," "X" "," "Y") file)
...
Wednesday, 27 March 2013
Posted by Unknown on 21:54 with 1 comment
(defun c:Pl_export(/ *error* file sset ename lst)
(vl-load-com)
(defun *error* (s)
(if file (close file))
(cond
( ( not s ) )
( (member s '("Function cancelled" "quit / exit abort") ) )
( (princ (strcat "\n---->Error:" s) ) )
)
(princ))
(if (setq sset (ssget "_:L" '((0 . "POLYLINE"))))
(progn
(if (setq file (open (strcat (getvar 'dwgprefix) "Polyline Vertex List.csv") "w"))
(progn
(write-line (strcat "X" "," "Y" "," "Z") file)
(repeat...
Posted by Unknown on 21:51 with No comments
(defun c:Lw_export (/ *error* file sset ename lst i)
(vl-load-com)
(defun *error* (s)
(if file
(close file)
)
(cond
((not s))
((member s '("Function cancelled" "quit / exit abort")))
((princ (strcat "\n---->Error:" s)))
)
(princ)
)
(if (setq sset (ssget "_:L" '((0 . "LWPOLYLINE,POLYLINE"))))
(progn
(if (setq file (open (strcat (getvar 'dwgprefix)
"Lwpolyline Vertex List.csv"
)
"w"
)
)
(progn
(write-line (strcat "X" "," "Y") file)
(repeat (setq i (sslength...
Posted by Unknown on 04:40 with No comments
(defun c:lw (/ *error* acdoc width ss )
(vl-load-com)
(defun *error* (s)
(if acdoc (vla-endundomark acdoc))
(cond
( (not s ) )
( (member s '("Function cancelled" "quit / exit abort") ) )
( (vl-exit-with-error (strcat "\n----Error:" s) ) )
)
(princ))
(setq acdoc (vla-get-activedocument
(vlax-get-acad-object)
)
)
(vla-startundomark acdoc)
(if (setq ss (ssget "_:L" '((0 . "LWPOLYLINE"))))
(progn
(setq width (getreal "\nEnter New Width Value:"))
(vlax-for...
Tuesday, 26 March 2013
Posted by Unknown on 22:33 with No comments
(defun c:Dle (/ ext lst s sset lay)
(while (null ext)
(setvar 'errno 0)
(if sset
(initget "Undo")
)
(setq s (entsel "\nPick An object to Erase[Undo]:"))
(cond
((= 7 (getvar 'errno))
(princ "\nMissed.Try again.")
)
((= "Undo" s)
(if lst
(progn
(setq sset (car lst))
(setq lst (cdr lst))
(repeat (sslength sset)
(entdel (ssname sset 0))
(ssdel (ssname sset 0) sset)
)
)
(princ "\nNothing to Undo.")
)
)
((= 'ename (type (car s)))
(setq lay (cdr...
Monday, 25 March 2013
Posted by Unknown on 22:12 with No comments
(defun c:TTx ()
(defun *error* (msg)
(if (not
(member msg '("Function cancelled" "quit / exit abort"))
)
(princ msg)
)
(setvar 'cmdecho cmh)
(princ)
)
(setq cmh (getvar 'cmdecho))
(setvar 'cmdecho 0)
(if (setq ss (ssget '((0 . "TEXT") (1 . "##.###,#*"))))
(progn
(setq cntr 0
len (sslength ss)
total 0
)
(repeat len
(setq ssnm (ssname ss cntr))
(setq ent (entget ssnm))
...
Sunday, 24 March 2013
Posted by Unknown on 23:06 with No comments
(defun c:icp (/ image object fuzz i l len p lst pts)
(vl-load-com)
(if
(and
(setq image (car (entsel "\nSelect RasterImage:")))
(setq Object (car (entsel "\nSelect Clipping Object:")))
)
(progn
(setq l nil
fuzz 0.1
i fuzz
)
(cond
((eq (cdr (assoc 0 (entget object))) "CIRCLE")
(setq len (vlax-get (vlax-ename->vla-object object)
'circumference
)
)
(repeat (fix (/ len fuzz))
(setq p (vlax-curve-getpointatdist object fuzz))
(setq l (cons...
Thursday, 14 March 2013
Posted by Unknown on 05:46 with No comments
;; Sub Programs for Get Mid Point Between Two Points
;Method-1
(defun _Midpoint (a b)
(list
(/ (+ (car a) (car b)) 2)
(/ (+ (cadr a) (cadr b)) 2)
)
)
;Method-2
(defun _Midpoint (a b)
(setq ang (angle a b))
(setq distoff (/ (distance a b) 2))
(polar a ang distoff)
)
;Method-3
(defun c:Test ()
(setq a (getpoint)
b (getpoint)
)
(setq ang (angle a b))
(setq ofdist (/ (distance a b) 2))
(setq m (polar...
Subscribe to:
Posts (Atom)
