infeeeee/lisp-scr
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Initial commit

Browse Source
This commit is contained in:
Péter Gyetvai
2018-11-26 22:23:22 +01:00
parent 317403389d
commit 86753f6ca0
50 changed files with 4573 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
README.md
View File

@@ -1,3 +1,5 @@
# lisp-scr
My lisp and acad scripts
My lisp and acad scripts.
Scripts in downloaded folder are not my work, they are from the internet.

29
allToZero.lsp Normal file
View File

@@ -0,0 +1,29 @@
(defun C:alltozero (/ i imax il ss currElem currPos newPos newElem)
;variables:
(setq i 0);counter to zero
(setq imax 1);while variable
(graphscr)
(setq ss (ssget "_A" '((0 . "insert"))));select all
(setq il (sslength ss));length of selection
(while imax
(setq currElem (entget (ssname ss i) ))
(setq currPos (assoc 10 currElem))
;; (cdr (assoc 10 currElem))
(setq newPos (list 10 0 0 0))
(setq newElem (subst newPos currPos currElem))
(entmod newElem)
;while specific:
(setq i (1+ i));increments i
(if (= i il) (setq imax nil));finish function if i equals il
)
)

1
autosave.lsp Normal file
View File

@@ -0,0 +1 @@
(setvar "SAVETIME" 15)

40
bindImages.lsp Normal file
View File

@@ -0,0 +1,40 @@
(defun C:bindimages (/ i imax il ss currElem currPos newPos newElem)
;variables:
(setq i 0);counter to zero
(setq imax 1);while variable
(graphscr)
(setq ss (ssget "_A" '((0 . "insert"))));select all
(setq il (sslength ss));length of selection
(while imax
(setq currElem (entget (ssname ss i) ))
(setq currPos (assoc 10 currElem))
;; (cdr (assoc 10 currElem))
(setq newPos (list 10 0 0 0))
(setq newElem (subst newPos currPos currElem))
(entmod newElem)
;while specific:
(setq i (1+ i));increments i
(if (= i il) (setq imax nil));finish function if i equals il
)
)

9
blockbase.lsp Normal file
View File

@@ -0,0 +1,9 @@
(defun C:bb (/ ss newpoint goodpoint)
(graphscr)
(prompt "\nselect entities to move (all): ")
(setq ss (ssget));asks for selection
(setq newpoint (getpoint "\nPick new basepoint"))
(setq goodpoint(subst 0.0 (nth 2 newpoint) newpoint))
(print goodpoint)
(command "._move" ss "" "_non" goodpoint "_non" "0,0,0")
)

123
blockpres.lsp Normal file
View File

@@ -0,0 +1,123 @@
;;blockpres.lsp
;;
;;Routine for block presentation in a file. It sorts the selected blocks in alphabetical order, and align them to a nice grid.
;;
;; Created by Peter Gyetvai
;; gyetpet@gmail.com
;; gyetvai-peter.hu
(defun C:blockpres (/ i imax j jmax ss goodsel colnr il jl distance currSel currElem newElem currTyp currPos currName currColNr currRowNr nameList nameListOrder currOrder)
;variables:
(setq i 0);counter to zero
(setq imax 1);while variable
(setq j 0);counter to zero
(setq jmax 1);while variable
(setq currColNr 0)
(setq currRowNr 0)
(setq nameList ())
(setq goodsel (ssadd))
(vl-load-com)
(graphscr)
(prompt "\nSelect blocks: [All]")
(setq ss (ssget));asks for selection
(setq jl (sslength ss));length of selection
(setq distance (getdist "\nDistance between blocks? "))
(setq colnr (getint "\nNumber of columns? "))
;; gets the blocks name
(while jmax
(print )
(princ "Checking element ")
(princ (1+ j))
(princ "/")
(princ jl)
(setq currSel (ssname ss j))
(setq currElem (entget currSel))
(setq currName (cdr (assoc 2 currElem)))
(setq currTyp (cdr (assoc 0 currElem)))
(princ " - type: ")
(princ currTyp)
;; checks if it's a block
(cond
(
(= currTyp "INSERT");if block
(progn
(princ " - name: ")
(princ currName)
(setq nameList (append nameList (list (strcase currName))))
;; (print nameList)
(ssadd currSel goodsel)
)
)
(
(not (= currTyp "INSERT"));if not block
(progn
(princ ": This is not a block")
)
)
)
;while specific:
(setq j (1+ j));increments j
(if (= j jl) (setq jmax nil));finish function if j equals jl
)
;; sorts the block names
(setq nameListOrder (vl-sort-i nameList '<))
;; length of new selection set
(setq il (sslength goodsel))
(print )
;; Modify coordinates
(while imax
(print )
(princ "Moving element ")
(princ (1+ i))
(princ "/")
(princ il)
(setq currOrder (nth i nameListOrder))
(setq currElem (entget (ssname goodsel currOrder) ))
(setq currPos (assoc 10 currElem))
(princ " - block name: ")
(princ (cdr (assoc 2 currElem)))
(print )
(setq newPos (list 10 (* currColNr distance) (* currRowNr distance) 0))
(setq newElem (subst newPos currPos currElem))
(entmod newElem)
;; ATTSYNC
(command "._ATTSYNC" "N" (cdr (assoc 2 currElem)))
;; change col and row numbers
(setq currColNr (1+ currColNr))
(if (= currColNr colnr)
(progn
(setq currRowNr (1+ currRowNr))
(setq currColNr 0)
)
)
;while specific:
(setq i (1+ i));increments i
(if (= i il) (setq imax nil));finish function if i equals il
)
(setq ss nil)
(princ)
)

51
dimMeter.lsp Normal file
View File

@@ -0,0 +1,51 @@
(defun C:dimmeter (/ allelems goodStyleElem goodStyleList goodStyleType goodStyle ii imax ilength currElem currLength currStyle newStyle newElem)
(setq goodStyleElem (entsel "Select dimension with meter based dimstyle: "))
(setq goodStyleList (entget (car goodStyleElem)))
(setq goodStyleType (cdr(assoc 0 goodStyleList)))
(setq goodStyle (cdr(assoc 3 goodStyleList)))
(princ "\nSelected dimstyle: " )
(princ goodStyle)
(if (wcmatch goodStyleType "DIMENSION")
(progn
(setq imax 1);while variable
(setq ii 0);counter to zero
(setq allelems (ssget "x" '((0 . "DIMENSION"))))
(setq ilength (sslength allelems))
;; (print ilength)
(while imax
(print ii)
(setq currElem (entget (ssname allelems ii)))
(setq currLength (cdr (assoc 42 currElem)))
(setq currStyle (cdr (assoc 3 currElem)));; current dimension style
;; (print currLength)
(if (wcmatch currStyle goodStyle)
(print currStyle)
(if (> currLength 100)
(progn
(setq newStyle(cons 3 goodStyle))
(setq newElem(subst newStyle (assoc 3 currElem) currElem))
(entmod newElem)
)
)
)
;while specific:
(setq ii (1+ ii));increments i
(if (= ii ilength) (setq imax nil));finish function if i equals il
)
)
(princ "\nThat's not a dimension. Please select a dimension!");;else
)
(setq allelems nil)
(setq goodStyleElem nil)
)

106
downloaded/ArcToLine.lsp Normal file
View File

@@ -0,0 +1,106 @@
(defun c:ArcToLine (/ *error* blg blk ent objts cnt blgLoc pts stp mxp cur
ent2d)
(vl-load-com)
(defun *error* (msg)
(and uFlag (vla-EndUndoMark doc))
(and ov (mapcar (function setvar) vl ov))
(and msg
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **"))
)
)
(princ)
)
(defun blg (ent num / blg)
(repeat num
(setq blg (cons (list
(vla-getbulge ent (setq num (1- num)))
(trans (vlax-safearray->list
(variant-value
(vla-Get-coordinate ent num)
)
)
0
1
)
)
blg
)
)
)
)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object))
vl '("CMDECHO" "OSMODE" "ORTHOMODE")
ov (mapcar (function getvar) vl)
)
(prompt "\nSelect LWPOLYLINE To convert:")
(if
(and
(setq uFlag (not (vla-StartUndoMark doc)))
(mapcar (function setvar) vl '(0 0 0))
(setq pts nil ent (car (entsel "\nSelect Polyline Boundary:\n")))
(eq (cdr (assoc 0 (entget ent))) "LWPOLYLINE")
(setq alen (getdist "\nEnter line ncrement length: "))
)
(progn
(setq objts (vlax-ename->vla-object ent))
(setq cnt 0
blgLoc (blg objts (cdr (assoc 90 (entget ent))))
)
(foreach itm blgLoc
(setq cnt (1+ cnt))
(if (= (car itm) 0.0)
(setq pts (cons (trans (cadr itm) 1 0) pts))
(progn
(setq pts (cons (trans (cadr itm) 1 0) pts))
(setq stp (if (zerop
(setq cur (vlax-curve-getDistAtPoint
objts
(trans (cadr itm) 1 0)
)
)
)
(vla-get-length objts)
cur
)
nxp (if (>= (1+ cnt) (cdr (assoc 90 (entget ent))))
(vla-get-length objts)
(vlax-curve-getDistAtPoint
objts
(trans (cadr (nth cnt blgLoc)) 1 0)
)
)
)
(while (< (setq stp (+ stp alen)) nxp)
(setq
pts (cons (vlax-curve-getPointAtDist objts stp) pts)
)
)
)
)
)
clr
(if pts
(progn
(setq
ent2d (entmakex
(append
(list (cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 (length pts))
(cons 70 0)
)
(mapcar (function (lambda (p) (cons 10 p))) pts)
)
)
)(entdel ent)
)
)
(setq uFlag (vla-EndUndoMark doc))
)
)
(*error* nil)
(princ)
)

90
downloaded/Blockreplace.lsp Normal file
View File

@@ -0,0 +1,90 @@
(defun c:BRE (/ *error* blk f ss temp)
;; Replace multiple instances of selected blocks (can be different) with selected block
;; Size and Rotation will be taken from original block and original will be deleted
;; Required subroutines: AT:GetSel
;; Alan J. Thompson, 02.09.10
(vl-load-com)
(defun *error* (msg)
(and f *AcadDoc* (vla-endundomark *AcadDoc*))
(if (and msg (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*QUIT*,")))
(princ (strcat "\nError: " msg))
)
)
(if
(and
(AT:GetSel
entsel
"\nSelect replacement block: "
(lambda (x / e)
(if
(and
(eq "INSERT" (cdr (assoc 0 (setq e (entget (car x))))))
(/= 4 (logand (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 e))))) 4))
(/= 4 (logand (cdr (assoc 70 (entget (tblobjname "LAYER" (cdr (assoc 8 e)))))) 4))
)
(setq blk (vlax-ename->vla-object (car x)))
)
)
)
(princ "\nSelect blocks to be repalced: ")
(setq ss (ssget "_:L" '((0 . "INSERT"))))
)
(progn
(setq f (not (vla-startundomark
(cond (*AcadDoc*)
((setq *AcadDoc* (vla-get-activedocument (vlax-get-acad-object))))
)
)
)
)
(vlax-for x (setq ss (vla-get-activeselectionset *AcadDoc*))
(setq temp (vla-copy blk))
(mapcar (function (lambda (p)
(vl-catch-all-apply
(function vlax-put-property)
(list temp p (vlax-get-property x p))
)
)
)
'(Insertionpoint Rotation XEffectiveScaleFactor YEffectiveScaleFactor
ZEffectiveScaleFactor
)
)
(vla-delete x)
)
(vla-delete ss)
(*error* nil)
)
)
(princ)
)
(defun AT:GetSel (meth msg fnc / ent good)
;; meth - selection method (entsel, nentsel, nentselp)
;; msg - message to display (nil for default)
;; fnc - optional function to apply to selected object
;; Ex: (AT:GetSel entsel "\nSelect arc: " (lambda (x) (eq (cdr (assoc 0 (entget (car x)))) "ARC")))
;; Alan J. Thompson, 05.25.10
(setvar 'errno 0)
(while (not good)
(setq ent (meth (cond (msg)
("\nSelect object: ")
)
)
)
(cond
((vl-consp ent)
(setq good (cond ((or (not fnc) (fnc ent)) ent)
((prompt "\nInvalid object!"))
)
)
)
((eq (type ent) 'STR) (setq good ent))
((setq good (eq 52 (getvar 'errno))) nil)
((eq 7 (getvar 'errno)) (setq good (prompt "\nMissed, try again.")))
)
)
)

295
downloaded/ChangeBlockBasePointV1-5.lsp Normal file
View File

@@ -0,0 +1,295 @@
;;--------------------=={ Change Block Base Point }==-------------------;;
;; ;;
;; This program allows the user to change the base point for all ;;
;; block references of a block definition in a drawing. ;;
;; ;;
;; The program offers two commands: ;;
;; ;;
;; ------------------------------------------------------------------ ;;
;; CBP (Change Base Point) ;;
;; ------------------------------------------------------------------ ;;
;; ;;
;; This command will retain the insertion point coordinates for all ;;
;; references of the selected block. Hence visually, the block ;;
;; components will be moved around the insertion point when the ;;
;; base point is changed. ;;
;; ;;
;; ------------------------------------------------------------------ ;;
;; CBPR (Change Base Point Retain Reference Position) ;;
;; ------------------------------------------------------------------ ;;
;; ;;
;; This command will retain the position of the each block reference ;;
;; of the selected block. Hence, each block reference will be moved ;;
;; to retain the visual position when the base point is changed. ;;
;; ;;
;; ------------------------------------------------------------------ ;;
;; ;;
;; Upon issuing a command syntax at the AutoCAD command-line, the ;;
;; program will prompt the user to select a block for which to change ;;
;; the base point. ;;
;; ;;
;; Following a valid selection, the user is then prompted to specify ;;
;; a new base point relative to the selected block. ;;
;; ;;
;; The block definition (and block reference depending on the command ;;
;; used) will then be modified to reflect the new block base point. ;;
;; ;;
;; If the selected block is attributed, an ATTSYNC operation will ;;
;; also be performed to ensure all attributes are in the correct ;;
;; positions relative to the new base point. ;;
;; ;;
;; Finally, the active viewport is regenerated to reflect the changes ;;
;; throughout all references of the block. ;;
;; ;;
;; The program will furthermore perform successfully with rotated & ;;
;; scaled block references, constructed in any UCS plane. ;;
;; ;;
;; ------------------------------------------------------------------ ;;
;; Please Note: ;;
;; ------------------------------------------------------------------ ;;
;; ;;
;; A REGEN is required if the UNDO command is used to undo the ;;
;; operations performed by this program. ;;
;; ;;
;;----------------------------------------------------------------------;;
;; Author: Lee Mac, Copyright <20> 2013 - www.lee-mac.com ;;
;;----------------------------------------------------------------------;;
;; Version 1.5 - 20-10-2013 ;;
;;----------------------------------------------------------------------;;
;; Retains Insertion Point Coordinates
(defun c:cbp nil (LM:changeblockbasepoint nil))
;; Retains Block Reference Position
(defun c:cbpr nil (LM:changeblockbasepoint t))
;;----------------------------------------------------------------------;;
(defun LM:changeblockbasepoint ( flg / *error* bln cmd ent lck mat nbp vec )
(defun *error* ( msg )
(foreach lay lck (vla-put-lock lay :vlax-true))
(if (= 'int (type cmd)) (setvar 'cmdecho cmd))
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(while
(progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect Block: ")))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= 'ename (type ent))
(if (/= "INSERT" (cdr (assoc 0 (entget ent))))
(princ "\nSelected object is not a block.")
)
)
)
)
)
(if (and (= 'ename (type ent)) (setq nbp (getpoint "\nSpecify New Base Point: ")))
(progn
(setq mat (car (revrefgeom ent))
vec (mxv mat (mapcar '- (trans nbp 1 0) (trans (cdr (assoc 10 (entget ent))) ent 0)))
bln (LM:blockname (vlax-ename->vla-object ent))
)
(LM:startundo (LM:acdoc))
(vlax-for lay (vla-get-layers (LM:acdoc))
(if (= :vlax-true (vla-get-lock lay))
(progn
(vla-put-lock lay :vlax-false)
(setq lck (cons lay lck))
)
)
)
(vlax-for obj (vla-item (vla-get-blocks (LM:acdoc)) bln)
(vlax-invoke obj 'move vec '(0.0 0.0 0.0))
)
(if flg
(vlax-for blk (vla-get-blocks (LM:acdoc))
(if (= :vlax-false (vla-get-isxref blk))
(vlax-for obj blk
(if
(and
(= "AcDbBlockReference" (vla-get-objectname obj))
(= bln (LM:blockname obj))
(vlax-write-enabled-p obj)
)
(vlax-invoke obj 'move '(0.0 0.0 0.0) (mxv (car (refgeom (vlax-vla-object->ename obj))) vec))
)
)
)
)
)
(if (= 1 (cdr (assoc 66 (entget ent))))
(progn
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(vl-cmdf "_.attsync" "_N" bln)
(setvar 'cmdecho cmd)
)
)
(foreach lay lck (vla-put-lock lay :vlax-true))
(vla-regen (LM:acdoc) acallviewports)
(LM:endundo (LM:acdoc))
)
)
(princ)
)
;; RefGeom (gile)
;; Returns a list whose first item is a 3x3 transformation matrix and
;; second item the object insertion point in its parent (xref, block or space)
(defun refgeom ( ent / ang enx mat ocs )
(setq enx (entget ent)
ang (cdr (assoc 050 enx))
ocs (cdr (assoc 210 enx))
)
(list
(setq mat
(mxm
(mapcar '(lambda ( v ) (trans v 0 ocs t))
'(
(1.0 0.0 0.0)
(0.0 1.0 0.0)
(0.0 0.0 1.0)
)
)
(mxm
(list
(list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(list
(list (cdr (assoc 41 enx)) 0.0 0.0)
(list 0.0 (cdr (assoc 42 enx)) 0.0)
(list 0.0 0.0 (cdr (assoc 43 enx)))
)
)
)
)
(mapcar '- (trans (cdr (assoc 10 enx)) ocs 0)
(mxv mat (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx))))))
)
)
)
;; RevRefGeom (gile)
;; The inverse of RefGeom
(defun revrefgeom ( ent / ang enx mat ocs )
(setq enx (entget ent)
ang (cdr (assoc 050 enx))
ocs (cdr (assoc 210 enx))
)
(list
(setq mat
(mxm
(list
(list (/ 1.0 (cdr (assoc 41 enx))) 0.0 0.0)
(list 0.0 (/ 1.0 (cdr (assoc 42 enx))) 0.0)
(list 0.0 0.0 (/ 1.0 (cdr (assoc 43 enx))))
)
(mxm
(list
(list (cos ang) (sin ang) 0.0)
(list (- (sin ang)) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(mapcar '(lambda ( v ) (trans v ocs 0 t))
'(
(1.0 0.0 0.0)
(0.0 1.0 0.0)
(0.0 0.0 1.0)
)
)
)
)
)
(mapcar '- (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx)))))
(mxv mat (trans (cdr (assoc 10 enx)) ocs 0))
)
)
)
;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
;; Matrix x Matrix - Vladimir Nesterovsky
;; Args: m,n - nxn matrices
(defun mxm ( m n )
((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)
;; Matrix Transpose - Doug Wilson
;; Args: m - nxn matrix
(defun trp ( m )
(apply 'mapcar (cons 'list m))
)
;; Block Name - Lee Mac
;; Returns the true (effective) name of a supplied block reference
(defun LM:blockname ( obj )
(if (vlax-property-available-p obj 'effectivename)
(defun LM:blockname ( obj ) (vla-get-effectivename obj))
(defun LM:blockname ( obj ) (vla-get-name obj))
)
(LM:blockname obj)
)
;; Start Undo - Lee Mac
;; Opens an Undo Group.
(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)
;; End Undo - Lee Mac
;; Closes an Undo Group.
(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)
;; Active Document - Lee Mac
;; Returns the VLA Active Document Object
(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
;;----------------------------------------------------------------------;;
(vl-load-com)
(princ
(strcat
"\n:: ChangeBlockBasePoint.lsp | Version 1.5 | \\U+00A9 Lee Mac "
(menucmd "m=$(edtime,0,yyyy)")
" www.lee-mac.com ::"
"\n:: Available Commands:"
"\n:: \"CBP\" - Retain Insertion Point Position"
"\n:: \"CBPR\" - Retain Block Reference Position"
)
)
(princ)
;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;;

70
downloaded/Ellipse2pline.lsp Normal file
View File

@@ -0,0 +1,70 @@
; Ellipse or ellipse arc to polyline
; Written By: Peter Jamtgaard 8/1/2006
; Modified by Tom Beauford to convert Lines, Arcs, Splines, and Circles as well.
; Menu item: ^P(or C:El2p (load "El2p.lsp"));El2p
(defun C:El2p (/ El2p ss count)
(defun El2p (ent / sngIncrement sngPosition pedacept)
(setq obj (vlax-ename->vla-object ent)
EnTyp (cdr (assoc 0 (entget ent)))
)
(princ "\nEntity Type = ")(princ EnTyp)
(cond
((= EnTyp "ELLIPSE")
(setq obj (vlax-ename->vla-object ent)
sngIncrement (/ (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)) 100.0)
sngPosition 0.0
)
(command "ortho" "off" "pline")
(repeat 101
(command (vlax-curve-getpointatdist obj sngPosition))
(setq sngPosition (+ sngPosition sngIncrement))
)
(command "")
); EnTyp = ELLIPSE
((= EnTyp "CIRCLE")
(setq obj (vlax-ename->vla-object ent)
ps (vlax-variant-value (vlax-get-property obj 'Center)); Center
center (vlax-safearray->list ps) ; Center
radius (vlax-get-property obj 'Radius) ; Radius
pt1 (polar center 0 radius) ; start point for polyline
pt2 (polar center 3.14159 radius) ; second point for pline arc
ELA (vlax-get-property obj 'Layer) ; layer
ELT (vlax-get-property obj 'Linetype) ; Linetype
ELS (vlax-get-property obj 'LinetypeScale) ; LinetypeScale
PltSty (vlax-get-property obj 'PlotStyleName) ; PlotStyleName
TruClr (vlax-get-property obj 'TrueColor) ; TrueColor
)
(command "pline" pt1 "Arc" "CE" center pt2 "Close")
(setq ent (entlast)
obj (vlax-ename->vla-object ent)
)
(vlax-dump-object EOBJ) ; List object properties
(vl-catch-all-apply 'vla-put-Layer (list EOBJ ELA))
(vl-catch-all-apply 'vla-put-Linetype (list EOBJ ELT))
(vl-catch-all-apply 'vla-put-LinetypeScale (list EOBJ ELS))
(vl-catch-all-apply 'vla-put-PlotStyleName (list EOBJ PltSty))
(vl-catch-all-apply 'vla-put-TrueColor (list EOBJ TruClr))
); EnTyp = CIRCLE
((or(= EnTyp "ARC")(= EnTyp "LINE"))
(setq pedacept (Getvar "peditaccept"))
(setvar "peditaccept" 1)
(command "_.pedit" ent "_exit")
(setvar "peditaccept" pedacept)
); EnTyp = ARC or LINE
(T(princ "\nEntity Type = ")(princ EnTyp))
); if (= (type ent) 'ENAME)
; (vla-delete objEllipse)
(princ)
)
(princ "\nSelect Lines, Arcs, Splines, Circles, Ellipses, and Ellipse Arcs: ")
(setq count 0)
(if (setq ss (ssget '((0 . "line,arc,spline,circle,ellipse"))))
(repeat (sslength ss)
(el2p (ssname ss count))
(setq count (1+ count))
)
(princ "\nNo modifyable objects selected!")
)
(princ)
); defun C:El2p

364
downloaded/HatchMaker.lsp Normal file
View File

@@ -0,0 +1,364 @@
;;;CADALYST 10/05 Tip 2065: HatchMaker.lsp Hatch Maker (c) 2005 Larry Schiele
;;;* ====== B E G I N C O D E N O W ======
;;;* HatchMaker.lsp written by Lanny Schiele at TMI Systems Design Corporation
;;;* Lanny.Schiele@tmisystems.com
;;;* Tested on AutoCAD 2002 & 2006. -- does include a 'VL' function -- should work on Acad2000 on up.
(defun C:DrawHatch (/)
(command "undo" "be")
(setq os (getvar "OSMODE"))
(setvar "OSMODE" 0)
(command "UCS" "w")
(command "PLINE" "0,0" "0,1" "1,1" "1,0" "c")
(command "zoom" "c" "0.5,0.5" 1.1)
(setvar "OSMODE" os)
(setvar "SNAPMODE" 1)
(setvar "SNAPUNIT" (list 0.01 0.01))
(command "undo" "e")
(alert
"Draw pattern within 1x1 box using LINE or POINT entities only..."
)
(princ)
)
(defun C:SaveHatch (/ round dxf ListToFile
user SelSet SelSetSize ssNth
Ent EntInfo EntType pt1 pt2
Dist AngTo AngFrom XDir YDir
Gap DeltaX DeltaY AngZone Counter
Ratio Factor HatchName HatchDescr
FileLines FileLines FileName
Scaler ScaledX ScaledY RF x
y h _AB _BC _AC
_AD _DE _EF _EH _FH
DimZin
)
;;;* BEGIN NESTED FUNCTIONS
(defun round (num)
(if (>= (- num (fix num)) 0.5)
(fix (1+ num))
(fix num)
)
)
(defun dxf (code EnameOrElist / VarType)
(setq VarType (type EnameOrElist))
(if (= VarType (read "ENAME"))
(cdr (assoc code (entget EnameOrElist)))
(cdr (assoc code EnameOrElist))
)
)
(defun ListToFile (TextList FileName DoOpenWithNotepad
AsAppend / TextItem
File RetVal
)
(if (setq File (open FileName
(if AsAppend
"a"
"w"
)
)
)
(progn
(foreach TextItem TextList
(write-line TextItem File)
)
(setq File (close File))
(if DoOpenWithNotepad
(startapp "notepad" FileName)
)
)
)
(FindFile FileName)
)
;;;* END NESTED FUNCTIONS
(princ
(strcat
"\n."
"\n 0,1 ----------- 1,1"
"\n | | "
"\n | Lines and | "
"\n | points must | "
"\n | be snapped | "
"\n | to nearest | "
"\n | 0.01 | "
"\n | | "
"\n 0,0 ----------- 1,0"
"\n."
"\nNote: Lines must be drawn within 0,0 to 1,1 and lie on a 0.01 grid."
)
)
(textscr)
(getstring "\nHit [ENTER] to continue...")
(princ
"\nSelect 1x1 pattern of lines and/or points for new hatch pattern..."
)
(while (not (setq SelSet (ssget (list (cons 0 "LINE,POINT")))))
)
(setq ssNth 0
SelSetSize (sslength SelSet)
DimZin (getvar "DIMZIN")
)
(setvar "DIMZIN" 11)
(if (> SelSetSize 0)
(princ "\nAnalyaing entities...")
)
(while (< ssNth SelSetSize)
(setq Ent (ssname SelSet ssNth)
EntInfo (entget Ent)
EntType (dxf 0 EntInfo)
ssNth (+ ssNth 1)
)
(cond
((= EntType "POINT")
(setq pt1 (dxf 10 EntInfo)
FileLine (strcat "0,"
(rtos (car pt1) 2 6)
","
(rtos (cadr pt1) 2 6)
",0,1,0,-1"
)
)
(princ (strcat "\n" FileLine))
(setq FileLines (cons FileLine FileLines))
)
((= EntType "LINE")
(setq pt1 (dxf 10 EntInfo)
pt2 (dxf 11 EntInfo)
Dist (distance pt1 pt2)
AngTo (angle pt1 pt2)
AngFrom (angle pt2 pt1)
IsValid nil
)
(if
(or (equal (car pt1) (car pt2) 0.0001)
(equal (cadr pt1) (cadr pt2) 0.0001)
)
(setq DeltaX 0
DeltaY 1
Gap (- Dist 1)
IsValid T
)
(progn
(setq Ang (if (< AngTo pi)
AngTo
AngFrom
)
AngZone (fix (/ Ang (/ pi 4)))
XDir (abs (- (car pt2) (car pt1)))
YDir (abs (- (cadr pt2) (cadr pt1)))
Factor 1
RF 1
)
(cond
((= AngZone 0)
(setq DeltaY (abs (sin Ang))
DeltaX (abs (- (abs (/ 1.0 (sin Ang))) (abs (cos Ang)))
)
)
)
((= AngZone 1)
(setq DeltaY (abs (cos Ang))
DeltaX (abs (sin Ang))
)
)
((= AngZone 2)
(setq DeltaY (abs (cos Ang))
DeltaX (abs (- (abs (/ 1.0 (cos Ang))) (abs (sin Ang)))
)
)
)
((= AngZone 3)
(setq DeltaY (abs (sin Ang))
DeltaX (abs (cos Ang))
)
)
)
(if (not (equal XDir YDir 0.001))
(progn
(setq Ratio (if (< XDir YDir)
(/ YDir XDir)
(/ XDir YDir)
)
RF (* Ratio Factor)
Scaler (/ 1
(if (< XDir YDir)
XDir
YDir
)
)
)
(if (not (equal Ratio (round Ratio) 0.001))
(progn
(while
(and
(<= Factor 100)
(not (equal RF (round RF) 0.001))
)
(setq Factor (+ Factor 1)
RF (* Ratio Factor)
)
)
(if (and (> Factor 1) (<= Factor 100))
(progn
(setq _AB (* XDir Scaler Factor)
_BC (* YDir Scaler Factor)
_AC (sqrt (+ (* _AB _AB) (* _BC _BC)))
_EF 1
x 1
)
(while (< x (- _AB 0.5))
(setq y (* x (/ YDir XDir))
h (if (< Ang (/ pi 2))
(- (+ 1 (fix y)) y)
(- y (fix y))
)
)
(if (< h _EF)
(setq _AD x
_DE y
_AE (sqrt (+ (* x x) (* y y)))
_EF h
)
)
(setq x (+ x 1))
)
(if (< _EF 1)
(setq _EH (/ (* _BC _EF) _AC)
_FH (/ (* _AB _EF) _AC)
DeltaX (+ _AE
(if (> Ang (/ pi 2))
(- _EH)
_EH
)
)
DeltaY (+ _FH)
Gap (- Dist _AC)
IsValid T
)
)
)
)
)
)
)
)
(if (= Factor 1)
(setq Gap (- Dist (abs (* Factor (/ 1 DeltaY))))
IsValid T
)
)
)
)
(if
IsValid
(progn
(setq FileLine
(strcat
(angtos AngTo 0 6)
","
(rtos (car pt1) 2 8)
","
(rtos (cadr pt1) 2 8)
","
(rtos DeltaX 2 8)
","
(rtos DeltaY 2 8)
","
(rtos Dist 2 8)
","
(rtos Gap 2 8)
)
)
(princ (strcat "\n" FileLine))
(setq FileLines (cons FileLine FileLines))
)
(princ (strcat "\n * * * Line with invalid angle "
(angtos AngTo 0 6)
(chr 186)
" omitted. * * *"
)
)
)
)
((princ
(strcat "\n * * * Invalid entity " EntType " omitted.")
)
)
)
)
(setvar "DIMZIN" DimZin)
(if
(and
FileLines
(setq HatchDescr
(getstring T
"\nBriefly describe this hatch pattern: "
)
)
(setq FileName (getfiled "Hatch Pattern File"
"I:\\Acad\\Hatch\\"
"pat"
1
)
)
)
(progn
(if (= HatchDescr "")
(setq HatchDescr "Custom hatch pattern")
)
(setq HatchName (vl-filename-base FileName)
FileLines (cons (strcat "*" HatchName "," HatchDescr)
(reverse FileLines)
)
)
(princ
"\n============================================================"
)
(princ
(strcat "\nPlease wait while the hatch file is created...\n"
)
)
(ListToFile FileLines FileName nil nil)
(command "delay" 1500) ;delay required so file can be created and found (silly, but req.)
(if (findfile FileName)
(progn
(setvar "HPNAME" HatchName)
(princ (strcat "\nHatch pattern '"
HatchName
"' is ready to use!"
)
)
)
(progn
(princ "\nUnable to create hatch pattern file:")
(princ (strcat "\n " FileName))
)
)
)
(princ
(if FileLines
"\nCancelled."
"\nUnable to create hatch pattern from selected entities."
)
)
)
(princ)
)
(princ "\n ************************************************************** ")
(princ "\n** **")
(princ "\n* HatchMaker.lsp written by Lanny Schiele -- enjoy! *")
(princ "\n* *")
(princ "\n* Type in DRAWHATCH to have the environment created to draw. *")
(princ "\n* Type in SAVEHATCH to save the pattern you created. *")
(princ "\n** **")
(princ "\n ************************************************************** ")
(princ)

364
downloaded/HatchMaker2.lsp Normal file
View File

@@ -0,0 +1,364 @@
;;;CADALYST 10/05 Tip 2065: HatchMaker.lsp Hatch Maker (c) 2005 Larry Schiele
;;;* ====== B E G I N C O D E N O W ======
;;;* HatchMaker.lsp written by Lanny Schiele at TMI Systems Design Corporation
;;;* Lanny.Schiele@tmisystems.com
;;;* Tested on AutoCAD 2002 & 2006. -- does include a 'VL' function -- should work on Acad2000 on up.
(defun C:DrawHatch (/)
(command "undo" "be")
(setq os (getvar "OSMODE"))
(setvar "OSMODE" 0)
(command "UCS" "w")
(command "PLINE" "0,0" "0,1" "1,1" "1,0" "c")
(command "zoom" "c" "0.5,0.5" 1.1)
(setvar "OSMODE" os)
(setvar "SNAPMODE" 1)
(setvar "SNAPUNIT" (list 0.01 0.01))
(command "undo" "e")
(alert
"Draw pattern within 1x1 box using LINE or POINT entities only..."
)
(princ)
)
(defun C:SaveHatch (/ round dxf ListToFile
user SelSet SelSetSize ssNth
Ent EntInfo EntType pt1 pt2
Dist AngTo AngFrom XDir YDir
Gap DeltaX DeltaY AngZone Counter
Ratio Factor HatchName HatchDescr
FileLines FileLines FileName
Scaler ScaledX ScaledY RF x
y h _AB _BC _AC
_AD _DE _EF _EH _FH
DimZin
)
;;;* BEGIN NESTED FUNCTIONS
(defun round (num)
(if (>= (- num (fix num)) 0.5)
(fix (1+ num))
(fix num)
)
)
(defun dxf (code EnameOrElist / VarType)
(setq VarType (type EnameOrElist))
(if (= VarType (read "ENAME"))
(cdr (assoc code (entget EnameOrElist)))
(cdr (assoc code EnameOrElist))
)
)
(defun ListToFile (TextList FileName DoOpenWithNotepad
AsAppend / TextItem
File RetVal
)
(if (setq File (open FileName
(if AsAppend
"a"
"w"
)
)
)
(progn
(foreach TextItem TextList
(write-line TextItem File)
)
(setq File (close File))
(if DoOpenWithNotepad
(startapp "notepad" FileName)
)
)
)
(FindFile FileName)
)
;;;* END NESTED FUNCTIONS
(princ
(strcat
"\n."
"\n 0,1 ----------- 1,1"
"\n | | "
"\n | Lines and | "
"\n | points must | "
"\n | be snapped | "
"\n | to nearest | "
"\n | 0.01 | "
"\n | | "
"\n 0,0 ----------- 1,0"
"\n."
"\nNote: Lines must be drawn within 0,0 to 1,1 and lie on a 0.01 grid."
)
)
(textscr)
(getstring "\nHit [ENTER] to continue...")
(princ
"\nSelect 1x1 pattern of lines and/or points for new hatch pattern..."
)
(while (not (setq SelSet (ssget (list (cons 0 "LINE,POINT")))))
)
(setq ssNth 0
SelSetSize (sslength SelSet)
DimZin (getvar "DIMZIN")
)
(setvar "DIMZIN" 11)
(if (> SelSetSize 0)
(princ "\nAnalyaing entities...")
)
(while (< ssNth SelSetSize)
(setq Ent (ssname SelSet ssNth)
EntInfo (entget Ent)
EntType (dxf 0 EntInfo)
ssNth (+ ssNth 1)
)
(cond
((= EntType "POINT")
(setq pt1 (dxf 10 EntInfo)
FileLine (strcat "0,"
(rtos (car pt1) 2 6)
","
(rtos (cadr pt1) 2 6)
",0,1,0,-1"
)
)
(princ (strcat "\n" FileLine))
(setq FileLines (cons FileLine FileLines))
)
((= EntType "LINE")
(setq pt1 (dxf 10 EntInfo)
pt2 (dxf 11 EntInfo)
Dist (distance pt1 pt2)
AngTo (angle pt1 pt2)
AngFrom (angle pt2 pt1)
IsValid nil
)
(if
(or (equal (car pt1) (car pt2) 0.00000000001)
(equal (cadr pt1) (cadr pt2) 0.00000000001)
)
(setq DeltaX 0
DeltaY 1
Gap (- Dist 1)
IsValid T
)
(progn
(setq Ang (if (< AngTo pi)
AngTo
AngFrom
)
AngZone (fix (/ Ang (/ pi 4)))
XDir (abs (- (car pt2) (car pt1)))
YDir (abs (- (cadr pt2) (cadr pt1)))
Factor 1
RF 1
)
(cond
((= AngZone 0)
(setq DeltaY (abs (sin Ang))
DeltaX (abs (- (abs (/ 1.0 (sin Ang))) (abs (cos Ang)))
)
)
)
((= AngZone 1)
(setq DeltaY (abs (cos Ang))
DeltaX (abs (sin Ang))
)
)
((= AngZone 2)
(setq DeltaY (abs (cos Ang))
DeltaX (abs (- (abs (/ 1.0 (cos Ang))) (abs (sin Ang)))
)
)
)
((= AngZone 3)
(setq DeltaY (abs (sin Ang))
DeltaX (abs (cos Ang))
)
)
)
(if (not (equal XDir YDir 0.001))
(progn
(setq Ratio (if (< XDir YDir)
(/ YDir XDir)
(/ XDir YDir)
)
RF (* Ratio Factor)
Scaler (/ 1
(if (< XDir YDir)
XDir
YDir
)
)
)
(if (not (equal Ratio (round Ratio) 0.001))
(progn
(while
(and
(<= Factor 100)
(not (equal RF (round RF) 0.001))
)
(setq Factor (+ Factor 1)
RF (* Ratio Factor)
)
)
(if (and (> Factor 1) (<= Factor 100))
(progn
(setq _AB (* XDir Scaler Factor)
_BC (* YDir Scaler Factor)
_AC (sqrt (+ (* _AB _AB) (* _BC _BC)))
_EF 1
x 1
)
(while (< x (- _AB 0.5))
(setq y (* x (/ YDir XDir))
h (if (< Ang (/ pi 2))
(- (+ 1 (fix y)) y)
(- y (fix y))
)
)
(if (< h _EF)
(setq _AD x
_DE y
_AE (sqrt (+ (* x x) (* y y)))
_EF h
)
)
(setq x (+ x 1))
)
(if (< _EF 1)
(setq _EH (/ (* _BC _EF) _AC)
_FH (/ (* _AB _EF) _AC)
DeltaX (+ _AE
(if (> Ang (/ pi 2))
(- _EH)
_EH
)
)
DeltaY (+ _FH)
Gap (- Dist _AC)
IsValid T
)
)
)
)
)
)
)
)
(if (= Factor 1)
(setq Gap (- Dist (abs (* Factor (/ 1 DeltaY))))
IsValid T
)
)
)
)
(if
IsValid
(progn
(setq FileLine
(strcat
(angtos AngTo 0 6)
","
(rtos (car pt1) 2 8)
","
(rtos (cadr pt1) 2 8)
","
(rtos DeltaX 2 8)
","
(rtos DeltaY 2 8)
","
(rtos Dist 2 8)
","
(rtos Gap 2 8)
)
)
(princ (strcat "\n" FileLine))
(setq FileLines (cons FileLine FileLines))
)
(princ (strcat "\n * * * Line with invalid angle "
(angtos AngTo 0 6)
(chr 186)
" omitted. * * *"
)
)
)
)
((princ
(strcat "\n * * * Invalid entity " EntType " omitted.")
)
)
)
)
(setvar "DIMZIN" DimZin)
(if
(and
FileLines
(setq HatchDescr
(getstring T
"\nBriefly describe this hatch pattern: "
)
)
(setq FileName (getfiled "Hatch Pattern File"
"I:\\Acad\\Hatch\\"
"pat"
1
)
)
)
(progn
(if (= HatchDescr "")
(setq HatchDescr "Custom hatch pattern")
)
(setq HatchName (vl-filename-base FileName)
FileLines (cons (strcat "*" HatchName "," HatchDescr)
(reverse FileLines)
)
)
(princ
"\n============================================================"
)
(princ
(strcat "\nPlease wait while the hatch file is created...\n"
)
)
(ListToFile FileLines FileName nil nil)
(command "delay" 1500) ;delay required so file can be created and found (silly, but req.)
(if (findfile FileName)
(progn
(setvar "HPNAME" HatchName)
(princ (strcat "\nHatch pattern '"
HatchName
"' is ready to use!"
)
)
)
(progn
(princ "\nUnable to create hatch pattern file:")
(princ (strcat "\n " FileName))
)
)
)
(princ
(if FileLines
"\nCancelled."
"\nUnable to create hatch pattern from selected entities."
)
)
)
(princ)
)
(princ "\n ************************************************************** ")
(princ "\n** **")
(princ "\n* HatchMaker.lsp written by Lanny Schiele -- enjoy! *")
(princ "\n* *")
(princ "\n* Type in DRAWHATCH to have the environment created to draw. *")
(princ "\n* Type in SAVEHATCH to save the pattern you created. *")
(princ "\n** **")
(princ "\n ************************************************************** ")
(princ)

36
downloaded/MLLA.lsp Normal file
View File

@@ -0,0 +1,36 @@
(DEFUN C:MLLA ( / )
(prompt "/nSelect multileaders: ")
(if (setq ss (ssget ":L" '((0 . "MULTILEADER")))); IF anything is found when to makes a selection of mleaders
(progn ; THEN
(setq mlent (entsel "/nSelect multileader to align to: "); prompt user to select mleader to align others to
ed (entget (car mlent)); store entity data for selected mleader
txxpt(cadr(assoc 12 ed)); store x point for text insertion
dlxpt(cadr (assoc 10 (member '(302 . "LEADER{") ed))); store x point for dogleg object
entqty (sslength ss); store quantity of mleaders selected
cnt 0); set counter to 0
(while (< cnt entqty); while there are still mleaders in list
(setq mlent (ssname ss cnt); store entity name (starting with the first mleader)
ed (entget mlent); store entity definition
old_txxpt (assoc 12 ed); store entities text object point data
new_txxpt (cons txxpt (cddr old_txxpt)); create new text object point data utilizing x point from mleader to align to
ed (subst (cons 12 new_txxpt) old_txxpt ed); swap old text object point data for new in entity record
old_tfxpt (assoc 10 ed); store entities text frame object point data
x-diff (- (- (cadr old_txxpt) txxpt)); find delta-x between current ent and selected alignment mleader
newx (+ x-diff (cadr old_tfxpt)); create new x point coordinate for text frame object
new_tfxpt (cons newx (cddr old_tfxpt)); create new text object point data utilizing newly created x point
ed (subst (cons 10 new_tfxpt) old_tfxpt ed); swap old text frame object point data for new in entity record
old_dlxpt (assoc 10 (member '(302 . "LEADER{") ed)); store entities dogleg object point data
new_dlxpt (cons dlxpt (cddr old_dlxpt)); create new dogleg object point data utilizing x point from mleader to align to
ed (subst (cons 10 new_dlxpt) old_dlxpt ed)); swap old dogleg object point data for new in entity record
(entmod ed); write new data to database
(setq cnt (1+ cnt)); set counter to advance to the next entity in selection set
); end WHILE
); end THEN
); end IF (no ELSE statement specified)
(princ); exit quietly
)
(princ); load clean

221
downloaded/PLDiet.lsp Normal file
View File

@@ -0,0 +1,221 @@
;;; PLDIET.lsp [command name: PLD]
;;; To put lightweight PolyLines on a DIET (remove excess vertices); usually
;;; used for contours with too many too-closely-spaced vertices.
;;; Concept from PVD routine [posted on AutoCAD Customization Discussion
;;; Group by oompa_l, July 2009] by Brian Hailey, added to by CAB, and
;;; WEED and WEED2 routines by Skyler Mills at Cadalyst CAD Tips [older
;;; routines for "heavy" Polylines that won't work on newer lightweight ones];
;;; simplified in entity data list processing, and enhanced in other ways [error
;;; handling, default values, join collinear segments beyond max. distance,
;;; limit to current space/tab, account for change in direction across 0 degrees,
;;; option to keep or eliminate arc segments] by Kent Cooper, August 2009.
;;; Last edited 28 August 2013
;
(defun C:PLD
(/ *error* cmde disttemp cidtemp arctemp plinc plsel pl
pldata ucschanged front 10to42 vinc verts vert1 vert2 vert3)
;
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errmsg))
); end if
(if ucschanged (command "_.ucs" "_prev"))
; ^ i.e. don't go back unless routine reached UCS change but didn't change back
(command "_.undo" "_end")
(setvar 'cmdecho cmde)
); end defun - *error*
;
(setq cmde (getvar 'cmdecho))
(setvar 'cmdecho 0)
(command "_.undo" "_begin")
(setq
disttemp
(getdist
(strcat
"\nMaximum distance between non-collinear vertices to straighten"
(if *distmax* (strcat " <" (rtos *distmax* 2 2) ">") ""); default only if not first use
": "
); end strcat
); end getdist & disttemp
*distmax*
(cond
(disttemp); user entered number or picked distance
(*distmax*); otherwise, user hit Enter - keep value
); end cond & *distmax*
cidtemp
(getangle
(strcat
"\nMaximum change in direction to straighten"
(strcat ; offer prior choice if not first use; otherwise 15 degrees
" <"
(if *cidmax* (angtos *cidmax*) (angtos (/ pi 12)))
">"
); end strcat
": "
); end strcat
); end getdist & cidtemp
*cidmax*
(cond
(cidtemp); user entered number or picked angle
(*cidmax*); Enter with prior value set - use that
((/ pi 12)); otherwise [Enter on first use] - 15 degrees
); end cond & *cidmax*
plinc 0 ; incrementer through selection set of Polylines
); end setq
(initget "Retain Straighten")
(setq
arctemp
(getkword
(strcat
"\nRetain or Straighten arc segments [R/S] <"
(if *arcstr* (substr *arcstr* 1 1) "S"); at first use, S default; otherwise, prior choice
">: "
); end strcat
); end getkword
*arcstr*
(cond
(arctemp); if User typed something, use it
(*arcstr*); if Enter and there's a prior choice, keep that
("Straighten"); otherwise [Enter on first use], Straighten
); end cond & *arcstr*
); end setq
;
(prompt "\nSelect LWPolylines to put on a diet, or press Enter to select all: ")
(cond
((setq plsel (ssget '((0 . "LWPOLYLINE"))))); user-selected Polylines
((setq plsel (ssget "X" (list '(0 . "LWPOLYLINE") (cons 410 (getvar 'ctab))))))
; all Polylines [in current space/tab only]
); end cond
;
(repeat (sslength plsel)
(setq pl (ssname plsel plinc))
(while
(equal (vlax-curve-getStartPoint pl) (vlax-curve-getPointAtParam pl 1) 1e-6)
; to correct for possibility that more than one vertices at beginning coincide,
; in which case Pline does not define a CS under UCS OBject, causing error
(command "_.pedit" pl "_edit" "_straighten" "" "" "_go" "_exit" "")
); while
(setq pldata (entget pl))
(if (/= (cdr (last pldata)) (trans '(0 0 1) 1 0)); extr. direction not parallel current CS
; for correct angle & distance calculations [projected onto current construction
; plane], since 10-code entries for LWPolylines are only 2D points:
(progn
(command "_.ucs" "_new" "_object" pl) ; set UCS to match object
(setq ucschanged T) ; marker for *error* to reset UCS if routine doesn't
); end progn
); end if
(setq
front ; list of "front end" [pre-vertices] entries, minus entity names & handle
(vl-remove-if
'(lambda (x)
(member (car x) '(-1 330 5 10 40 41 42 210))
); end lambda
pldata
); end removal & front
10to42 ; list of all code 10, 40, 41, 42 entries only
(vl-remove-if-not
'(lambda (x)
(member (car x) '(10 40 41 42))
); end lambda
pldata
); end removal & 10to42
vinc (/ (length 10to42) 4); incrementer for vertices within each Polyline
verts nil ; eliminate from previous Polyline [if any]
); end setq
(if (= *arcstr* "Straighten")
(progn
(setq bulges ; find any bulge factors
(vl-remove-if-not
'(lambda (x)
(and
(= (car x) 42)
(/= (cdr x) 0.0)
); end and
); end lambda
10to42
); end removal & bulges
); end setq
(foreach x bulges (setq 10to42 (subst '(42 . 0.0) x 10to42)))
; straighten all arc segments to line segments
); end progn
); end if
(repeat vinc
(setq
verts ; sub-group list: separate list of four entries for each vertex
(cons
(list
(nth (- (* vinc 4) 4) 10to42)
(nth (- (* vinc 4) 3) 10to42)
(nth (- (* vinc 4) 2) 10to42)
(nth (1- (* vinc 4)) 10to42)
); end list
verts
); end cons & verts
vinc (1- vinc) ; will be 0 at end
); end setq
); end repeat
(while (nth (+ vinc 2) verts); still at least 2 more vertices
(if
(or ; only possible if chose to Retain arc segments
(/= (cdr (assoc 42 (nth vinc verts))) 0.0); next segment is arc
(/= (cdr (assoc 42 (nth (1+ vinc) verts))) 0.0); following segment is arc
); end or
(setq vinc (1+ vinc)); then - don't straighten from here; move to next
(progn ; else - analyze from current vertex
(setq
vert1 (cdar (nth vinc verts)) ; point-list location of current vertex
vert2 (cdar (nth (1+ vinc) verts)); of next one
vert3 (cdar (nth (+ vinc 2) verts)); of one after that
ang1 (angle vert1 vert2)
ang2 (angle vert2 vert3)
); end setq
(if
(or
(equal ang1 ang2 0.0001); collinear, ignoring distance
(and
(<= (distance vert1 vert3) *distmax*)
; straightens if direct distance from current vertex to two vertices later is
; less than or equal to maximum; if preferred to compare distance along
; Polyline through intermediate vertex, replace above line with this:
; (<= (+ (distance vert1 vert2) (distance vert2 vert3)) *distmax*)
(<=
(if (> (abs (- ang1 ang2)) pi); if difference > 180 degrees
(+ (min ang1 ang2) (- (* pi 2) (max ang1 ang2)))
; then - compensate for change in direction crossing 0 degrees
(abs (- ang1 ang2)); else - size of difference
); end if
*cidmax*
); end <=
); end and
); end or
(setq verts (vl-remove (nth (1+ vinc) verts) verts))
; then - remove next vertext, stay at current vertex for next comparison
(setq vinc (1+ vinc)); else - leave next vertex, move to it as new base
); end if - distance & change in direction analysis
); end progn - line segments
); end if - arc segment check
); end while - working through vertices
(setq
front (subst (cons 90 (length verts)) (assoc 90 front) front)
; update quantity of vertices for front end
10to42 nil ; clear original set
); end setq
(foreach x verts (setq 10to42 (append 10to42 x)))
; un-group four-list vertex sub-lists back to one list of all 10, 40, 41, 42 entries
(setq pldata (append front 10to42 (list (last pldata))))
; put front end, vertex entries and extrusion direction back together
(entmake pldata)
(entdel pl); remove original
(setq plinc (1+ plinc)); go on to next Polyline
(if ucschanged
(progn
(command "_.ucs" "_prev")
(setq ucschanged nil) ; eliminate UCS reset in *error* since routine did it already
); end progn
); end if - UCS reset
); end repeat - stepping through set of Polylines
(command "_.undo" "_end")
(setvar 'cmdecho cmde)
(princ)
); end defun - PLD
(prompt "\nType PLD to put PolyLines on a Diet.")

35
downloaded/Polyarea.lsp Normal file
View File

@@ -0,0 +1,35 @@
;;POLYAREA.LSP
;; Adds the area of one or more closed polylines
;;
(defun C:POLYAREA (/ a ss n du)
(setq a 0
du (getvar "dimunit")
ss (ssget '((0 . "*POLYLINE"))))
(if ss
(progn
(setq n (1- (sslength ss)))
(while (>= n 0)
(command "_.area" "_o" (ssname ss n))
(setq a (+ a (getvar "area"))
n (1- n)))
(alert
(strcat "The total area of the selected\nobject(s) is "
(if (or (= du 3)(= du 4)(= du 6))
;
;The following 2 lines translate the area to square inches and feet
;for users using US engineering or architectural units:
;
(strcat (rtos a 2 2) " square inches,\nor "
(rtos (/ a 144.0) 2 3) " square feet.")
;
;In the following line, change the word "units" to whatever units
;you are using - meters, millimeters, feet, etc.
;
(strcat (rtos (/ a 10000) 2 3) " square meters.")))))
(alert "\nNo Polylines selected!"))
(princ)
)
(alert
(strcat "POLYAREA.LSP"
"\n\n Type POLYAREA to start"))
(princ)

1696
downloaded/StripMtext v5-0c.lsp Normal file
View File

File diff suppressed because it is too large Load Diff

105
downloaded/XClipM.lsp Normal file
View File

@@ -0,0 +1,105 @@
; XClipM.lsp allows user to select supported objects to Clip using multiple boundaries
; Current supported objects are:
; Block Insert, External Reference, Image, DGN, DWF, PDF
; Creating a donut hole clip is not supported
; written by: Paul Li - 12/02/2010
; updated on 3/19/2014 to support multiple objects to clip
; Note: circle shaped pline boundaries are not supported
(princ"\nLoading XclipM...")(princ)
(defun c:xclipm
(/ cmdecho count count1 emax emax1 en ChkClpBnd menuecho obxr obdxr obdxrtype obxrcopy ss ss1 xclipm_err xclipm_olderr) ; declare locally
(defun xclipm_err (msg) ; define own error function
(if (not (member msg '("console break" "Function cancelled" "quit / exit abort" ""))) ; if function not cancelled by user
(princ (strcat "\nError: " msg)) ; then show error message
) ; if
(setvar "cmdecho" cmdecho) ; restore command echo
(setvar "menuecho" menuecho)
(princ)
) ; defun
;end error function
(defun ChkClpBnd (ename / Data Dict tempDict)
; Check if object has existing clipping boundry
(if
(and
(setq Data (entget ename))
(setq Dict (cdr (assoc 360 Data)))
(setq tempDict (dictsearch Dict "ACAD_FILTER"))
(setq tempDict (dictsearch (cdr (assoc -1 tempDict)) "SPATIAL"))
)
(cons '(0 . "SPATIAL_FILTER") (member (assoc 100 tempDict) tempDict)) ; return object if existing clipping boundary found
)
) ; ChkClpBnd
(setq xclipm_olderr *error* ; Save error routine
*error* xclipm_err ; Substitute ours
)
(setq cmdecho (getvar"cmdecho")) ; save command echos
(setq menuecho (getvar"menuecho"))
(setvar"cmdecho"0)(setvar"menuecho"0) ; turn off command echos
(princ "\nSelect Block, DGN, DWF, Image, PDF or Xref to Clip:")
(setq ss1 (ssget '((-4 . "<OR")(0 . "IMAGE") (0 . "DGNUNDERLAY") (0 . "DWFUNDERLAY") (0 . "PDFUNDERLAY") (0 . "INSERT")(-4 . "OR>"))))
(if ss1
(progn
(princ"\nSelect Closed Boundaries to Use for Clipping:")
(setq ss (ssget (list '(-4 . "<AND") '(0 . "LWPOLYLINE") '(-4 . "&") '(70 . 1) '(-4 . "AND>"))))
(if ss
(progn
(setq count1 0) ; initialize counter
(setq emax1 (sslength ss1)) ; get length of ss1
(while (< count1 emax1) ; while there are still entities in ss1
(setq obxr (ssname ss1 count1)) ; get entity's name
(redraw obxr 3) ; highlite selected object
(setq obdxr (entget obxr)) ; retrieve objectives data
(setq obdxrtype (cdr(assoc 0 obdxr))) ; retrieve object type
(princ (strcat "\n" obdxrtype " Selected for Clipping..."))
(setq count 0) ; initialize counter
(setq emax (sslength ss)) ; get length of ss
(while (< count emax) ; while there are still entities in ss
(setq en (ssname ss count)) ; get entity's name
(cond
((= obdxrtype "INSERT") ; if block insert or xref
(command"_.COPY" obxr "" "0,0,0" "0,0,0") ; make copy of object to clip
(setq obxrcopy (entlast))
(if (ChkClpBnd obxrcopy)(command"_.XCLIP" obxrcopy "" "_D")) ; check if there's a clipping boundary & delete
(command"_.XCLIP" obxrcopy "" "_New" "_S" en) ; clip
)
((= obdxrtype "IMAGE") ; if image
(command"_.COPY" obxr "" "0,0,0" "0,0,0")
(setq obxrcopy (entlast))
(command"_.IMAGECLIP" obxrcopy "_D")
(command"_.IMAGECLIP" obxrcopy "_New" "_S" en)
)
((= obdxrtype "DGNUNDERLAY") ; if dgn
(command"_.COPY" obxr "" "0,0,0" "0,0,0")
(setq obxrcopy (entlast))
(command"_.DGNCLIP" obxrcopy "_D")
(command"_.DGNCLIP" obxrcopy "_New" "_S" en)
)
((= obdxrtype "DWFUNDERLAY") ; if dwf
(command"_.COPY" obxr "" "0,0,0" "0,0,0")
(setq obxrcopy (entlast))
(command"_.DWFCLIP" obxrcopy "_D")
(command"_.DWFCLIP" obxrcopy "_New" "_S" en)
)
((= obdxrtype "PDFUNDERLAY") ; if pdf
(command"_.COPY" obxr "" "0,0,0" "0,0,0")
(setq obxrcopy (entlast))
(command"_.PDFCLIP" obxrcopy "_D")
(command"_.PDFCLIP" obxrcopy "_New" "_S" en)
)
) ; cond
(setq count (1+ count)) ; advance to next boundary object
) ; while
(princ (strcat "\n" obdxrtype " Clipped Successfully to Selected Boundaries."))
(command"_.ERASE" obxr "") ; erase original object
(setq count1 (1+ count1)) ; advance to next boundary object
) ; while
) ; progn
(princ"\nNo Supported Closed Boundaries Selected.")
) ; if
) ; progn
(princ"\nNo Supported Objects Selected for Clipping.")
) ; if ss1
(if xclipm_olderr (setq *error* xclipm_olderr)) ; Restore old *error* handler
(setvar"cmdecho"cmdecho)(setvar"menuecho"menuecho)(princ) ; restore command echos
) ; defun xclipm
(princ"... Command loaded.")(princ)

BIN
downloaded/cad-corner.com/90lsp.zip Normal file
View File

Binary file not shown.

BIN
downloaded/cad-corner.com/Best Of Lisp.rar Normal file
View File

Binary file not shown.

BIN
downloaded/cad-corner.com/DetailBook.zip Normal file
View File

Binary file not shown.

BIN
downloaded/cad-corner.com/Power.rar Normal file
View File

Binary file not shown.

BIN
downloaded/cad-corner.com/archcalc.zip Normal file
View File

Binary file not shown.

BIN
downloaded/cad-corner.com/autopat.zip Normal file
View File

Binary file not shown.

BIN
downloaded/cad-corner.com/bylaybk.zip Normal file
View File

Binary file not shown.

BIN
downloaded/cad-corner.com/calc.zip Normal file
View File

Binary file not shown.

BIN
downloaded/cad-corner.com/clock.zip Normal file
View File

Binary file not shown.

32
downloaded/cad-corner.com/flat.lsp Normal file
View File

@@ -0,0 +1,32 @@
; Flatten a 3D drawing
; Written by Eduard
; This command will set all elevations and points to zero, efectively flattening any 3D drawing.
;
(defun c:flat (/ total-nabor)
(vl-load-com)
(if
(setq total-nabor (ssget "x" '((410 . "model"))))
(progn
(setq total-nabor
(mapcar 'vlax-ename->vla-object
(mapcar 'cadr
(ssnamex total-nabor)
) ;_ end of mapcar
) ;_ end of mapcar
) ;_ end of setq
(foreach i '(1e99 -1e99)
(mapcar (function (lambda (x)
(vla-move x
(vlax-3d-point (list 0 0 0))
(vlax-3d-point (list 0 0 i))
) ;_ end of vla-move
) ;_ end of lambda
) ;_ end of function
total-nabor
) ;_ end of mapcar
) ;_ end of foreach
) ;_ end of progn
) ;_ end of if
(princ)
) ;_ end of defun

BIN
downloaded/cad-corner.com/grabbag.zip Normal file
View File

Binary file not shown.

BIN
downloaded/cad-corner.com/library.zip Normal file
View File

Binary file not shown.

BIN
downloaded/cad-corner.com/mlayer.zip Normal file
View File

Binary file not shown.

BIN
downloaded/cad-corner.com/protxlsp.zip Normal file
View File

Binary file not shown.

52
downloaded/mtext to mleader.lsp Normal file
View File

@@ -0,0 +1,52 @@
;;; By RonJon
;;; Found at http://www.cadtutor.net/forum/showthread.php?41822-changing-text-mtext-to-multileaders...
(defun c:am (/ newleader pt1 pt2 ss txt x w rjp-getbbwdth)
(vl-load-com)
(defun rjp-getbbwdth (obj / out ll ur)
(vla-getboundingbox obj 'll 'ur)
(setq out (mapcar 'vlax-safearray->list (list ll ur)))
(distance (car out) (list (caadr out) (cadar out)))
)
(if (setq ss (ssget '((0 . "*TEXT"))))
(progn (setq txt (apply
'strcat
(mapcar
'cdr
(vl-sort
(mapcar '(lambda (x)
(cons (vlax-get x 'insertionpoint)
(strcat (vlax-get x 'textstring) " ")
)
)
(setq
ss (mapcar
'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
)
)
)
(function (lambda (y1 y2) (< (cadr (car y2)) (cadr (car y1))))
)
)
)
)
w (car (vl-sort (mapcar 'rjp-getbbwdth ss) '>))
txt (apply 'strcat
(mapcar 'chr (reverse (cdr (reverse (vl-string->list txt)))))
)
)
(mapcar 'vla-delete ss)
)
)
(if (and (setq pt1 (getpoint "\nSpecify leader arrowhead location: "))
(setq pt2 (getpoint pt1 "\nSpecify landing location: "))
)
(progn (command "._MLEADER" pt1 pt2 "")
(setq newleader (vlax-ename->vla-object (entlast)))
(vla-put-textstring newleader txt)
(vla-put-textwidth newleader w)
)
)
(princ)
)

32
downloaded/tlen.lsp Normal file
View File

@@ -0,0 +1,32 @@
;|
TLEN.LSP - Total LENgth of selected objects
(c) 1998 Tee Square Graphics
|;
(defun C:TLEN (/ ss tl n ent itm obj l)
(setq ss (ssget)
tl 0
n (1- (sslength ss)))
(while (>= n 0)
(setq ent (entget (setq itm (ssname ss n)))
obj (cdr (assoc 0 ent))
l (cond
((= obj "LINE")
(distance (cdr (assoc 10 ent))(cdr (assoc 11 ent))))
((= obj "ARC")
(* (cdr (assoc 40 ent))
(if (minusp (setq l (- (cdr (assoc 51 ent))
(cdr (assoc 50 ent)))))
(+ pi pi l) l)))
((or (= obj "CIRCLE")(= obj "SPLINE")(= obj "POLYLINE")
(= obj "LWPOLYLINE")(= obj "ELLIPSE"))
(command "_.area" "_o" itm)
(getvar "perimeter"))
(T 0))
tl (+ tl l)
n (1- n)))
(alert (strcat "Total length of selected objects is " (rtos tl)))
(princ)
)

47
dxf examples/polyline.txt Normal file
View File

@@ -0,0 +1,47 @@
(
(-1 . <Entity name: 1fd68a72cc0>) APP: entity name (changes each time a drawing is opened)
(0 . "LWPOLYLINE") Entity type
(330 . <Entity name: 1fd68a6b9f0>) Soft-pointer ID/handle to owner dictionary (optional)
(5 . "27C") Handle
(100 . "AcDbEntity") Subclass marker (AcDbEntity)
(67 . 0) Absent or zero indicates entity is in model space. 1 indicates entity is in paper space (optional).
(410 . "Model") APP: layout tab name
(8 . "0") Layer
(100 . "AcDbPolyline") Subclass marker (AcDb2dPolyline or AcDb3dPolyline)
(90 . 3)
(70 . 0) Polyline flag (bit-coded; default = 0):
(43 . 0.0)
(38 . 0.0)
(39 . 0.0)
(10 1803.05 2175.82)
(40 . 0.0) Default start width (optional; default = 0)
(41 . 0.0) Default end width (optional; default = 0)
(42 . 0.0)
(91 . 0)
(10 3137.32 1449.0)
(40 . 0.0) Default start width (optional; default = 0)
(41 . 0.0) Default end width (optional; default = 0)
(42 . 0.0)
(91 . 0)
(10 3790.2 665.109)
(40 . 0.0) Default start width (optional; default = 0)
(41 . 0.0) Default end width (optional; default = 0)
(42 . 0.0)
(91 . 0)
(210 0.0 0.0 1.0)
)
(
(-1 . <Entity name: 1fd68a72db0>)
(0 . "LINE")
(330 . <Entity name: 1fd68a6b9f0>)
(5 . "28B")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(100 . "AcDbLine")
(10 4421.78 702.849 0.0)
(11 4006.62 985.206 0.0)
(210 0.0 0.0 1.0)
)

39
dxf examples/rotated dimension Normal file
View File

@@ -0,0 +1,39 @@
(
(-1 . <Entity name: 21afebafcf0>)
(0 . "DIMENSION")
(330 . <Entity name: 21afee189f0>)
(5 . "3B77")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "A-ANNO-DIMS")
(100 . "AcDbDimension")
(280 . 0)
(2 . "*D58")
(10 1268.78 538.065 0.0)
(11 1262.4 435.815 0.0)
(12 0.0 0.0 0.0)
(70 . 32)
(1 . "11 {\\H0.7x;\\S7/8;}\" TJI 360 AT 16\" OC")
(71 . 5)
(72 . 1)
(41 . 1.0)
(42 . 204.5)
(73 . 0)
(74 . 0)
(75 . 0)
(52 . 0.0)
(53 . 0.0)
(54 . 0.0)
(51 . 0.0)
(210 0.0 0.0 1.0)
(3 . "Arrows")
(100 . "AcDbAlignedDimension")
(13 1224.26 333.565 0.0)
(14 1256.76 538.065 0.0)
(15 0.0 0.0 0.0)
(16 0.0 0.0 0.0)
(40 . 0.0)
(50 . 1.5708)
(100 . "AcDbRotatedDimension")
)

109
dxfval.lsp Normal file
View File

@@ -0,0 +1,109 @@
;; dxfval.lsp
;;
;; A simple lisp, which prints the dxf properties of elements to the console
;;
;; Created by Peter Gyetvai
;; gyetpet@gmail.com
;; gyetvai-peter.hu
(defun C:dxfval (/ i imax il j jmax jl x ss currElem code groupCode en2 enlist2 )
;variables:
(setq i 0);counter to zero
(setq imax 1);while variable
(setq j 0);counter to zero
(setq jmax 1);while variable
;; (vl-load-com)
(graphscr)
(initget 1 "Pick All")
(setq x (getkword "Pick elements or all? [Pick/All]"))
(if (= x "Pick")
(progn
(prompt "\nSelect elements: [All]")
(setq ss (ssget));asks for selection
)
(setq ss (ssget "_X"))
)
(setq il (sslength ss));length of selection
(prompt "\nDxf group code: (leave empty for all) ")
(setq groupCode (getint))
(print groupCode)
(while imax
(print )
(print )
(princ "Checking element ")
(princ (1+ i))
(princ "/")
(princ il)
(setq currElem (entget (ssname ss i) ))
(if groupCode
(progn
(print (cdr (assoc groupCode currElem)))
)
(progn
(setq jl (length currElem))
(while jmax
(print (nth j currElem))
(setq j (1+ j));increments i
(if (= j jl) (setq jmax nil));finish function if i equals il
)
(setq j 0);counter to zero
(setq jmax 1);while variable
(setq en2(entnext (ssname ss i))) ;- Get the next sub-entity
(if en2
(progn
(print )
(princ "Sub entities: ")
(setq enlist2(entget en2)) ;- Get the DXF group codes
(while (/= (cdr(assoc 0 enlist2)) "SEQEND") ;- Start the while loop and keep ;- looping until SEQEND is found.
(princ "\n ") ;-Print a new line
(princ enlist2) ;- Print the attribute DXF group codes
(setq en2(entnext en2))
(setq enlist2(entget en2))
(print "enlist2 ok")
)
)
(progn
(print )
(princ "No sub entities")
)
)
)
)
(if (not (or (= il 1)(= (1+ i) il)))
(progn
(prompt "\nPress any key to continue to the next element: ")
(setq code (grread))
)
)
;while specific:
(setq i (1+ i));increments i
(if (= i il) (setq imax nil));finish function if i equals il
)
(setq ss nil)
(princ)
)

29
imagePaths.lsp Normal file
View File

@@ -0,0 +1,29 @@
(defun c:imagePaths (Doc / LayoutCol EndList)
; Returns a list of list of all the Xrefs and Images with their paths withina drawing.
(vl-load-com)
(if (not Doc)
(setq Doc (vla-get-ActiveDocument (vlax-get-Acad-Object)))
)
(setq LayoutCol (vla-get-Layouts Doc))
(vlax-for i LayoutCol
(vlax-for Obj (vla-get-Block i)
(cond
((= (vla-get-ObjectName Obj) "AcDbRasterImage")
(if (not (assoc (vla-get-Name Obj) EndList))
(setq EndList (cons (cons (vla-get-Name Obj) (vla-get-ImageFile Obj))
EndList))
)
)
((and (= (vla-get-ObjectName Obj) "AcDbBlockReference")
(vlax-property-available-p Obj 'Path))
(if (not (assoc (vla-get-Name Obj) EndList))
(setq EndList (cons (cons (vla-get-Name Obj) (vla-get-Path Obj))
EndList))
)
)
)
)
)
EndList
)

71
layerFromColor.lsp Normal file
View File

@@ -0,0 +1,71 @@
(defun C:LFC (/ i imax il ss currElem color colorNum allColors newLayer currLayer newElem)
(graphscr)
;variables:
(setq i 0);counter to zero
(setq imax 1);while variable
(prompt "\nselect entities to change layer (all): ")
(setq ss (ssget));asks for selection
(setq il (sslength ss));length of selection
(setq allColors nil)
(while imax
(print i)
(setq currElem (entget (ssname ss i) ))
(setq color (assoc 62 currElem))
(setq colorNum (cdr color))
(print colorNum)
(if (and (not (= colorNum 0)) colorNum)
(progn
(if (not (type allColors))( setq allColors (list colorNum)))
(if (not (member colorNum allColors)) (setq allColors (append allColors (list colorNum))))
)
)
;while specific:
(setq i (1+ i));increments i
(if (= i il) (setq imax nil));finish function if i equals il
)
(setq i 0);counter to zero
(setq imax 1);while variable
(while imax
(print i)
(setq color (nth i allColors))
(command "._layer" "_M" color "")
;while specific:
(setq i (1+ i));increments i
(if (= i (length allColors)) (setq imax nil));finish function if i equals il
)
(setq i 0);counter to zero
(setq imax 1);while variable
(while imax
(print i)
(setq currElem (entget (ssname ss i) ))
(setq color (assoc 62 currElem))
(setq colorNum (cdr color))
(if (and (not (= colorNum 0)) colorNum)
(progn
(setq currLayer (assoc 8 currElem))
(setq newLayer (cons 8 (itoa colorNum)))
(print newLayer)
(setq newElem(subst newLayer currLayer currElem))
(entmod newElem)
)
)
;while specific:
(setq i (1+ i));increments i
(if (= i il) (setq imax nil));finish function if i equals il
)
(terpri)
(setq ss nil)
)

18
mleaderHeight.lsp Normal file
View File

@@ -0,0 +1,18 @@
(defun c:foo (/ e elev ss)
(if
(and (setq elev (getdist "\nEnter elevation: ")) (setq ss (ssget ":L" '((0 . "MULTILEADER")))))
(while (setq e (ssname ss 0))
(entmod (mapcar '(lambda (x)
(if (member (car x) '(10 12 110))
(list (car x) (cadr x) (caddr x) elev)
x
)
)
(entget e '("*"))
)
)
(ssdel e ss)
)
)
(princ)
)

136
pline-3d-2d.lsp Normal file
View File

@@ -0,0 +1,136 @@
;;CADALYST 09/03 AutoLISP Solutions
;;; PLINE-3D-2D.LSP - a program to convert
;;; 3D polylines to 2D
;;; Program by Tony Hotchkiss
(defun pline-3d-2d ()
(vl-load-com)
(setq *thisdrawing* (vla-get-activedocument
(vlax-get-acad-object)
) ;_ end of vla-get-activedocument
*modelspace* (vla-get-ModelSpace *thisdrawing*)
) ;_ end of setq
(setq 3d-pl-list
(get-3D-pline)
) ;_ end of setq
(if 3d-pl-list
(progn
(setq vert-array-list (make-list 3d-pl-list))
(setq n (- 1))
(repeat (length vert-array-list)
(setq vert-array (nth (setq n (1+ n)) vert-array-list))
(setq lyr (vlax-get-property (nth n 3d-pl-list) 'Layer))
(setq obj (vla-AddPolyline *modelspace* vert-array))
(vlax-put-property obj 'Layer lyr)
) ;_ end of repeat
(foreach obj 3d-pl-list (vla-delete obj))
) ;_ end of progn
) ;_ end of if
) ;_ end of pline-3d-2d
(defun get-3D-pline ()
(setq pl3dobj-list nil
obj nil
3d "AcDb3dPolyline"
) ;_ end of setq
(setq selsets (vla-get-selectionsets *thisdrawing*))
(setq ss1 (vlax-make-variant "ss1"))
(if (= (vla-get-count selsets) 0)
(setq ssobj (vla-add selsets ss1))
) ;_ end of if
(vla-clear ssobj)
(setq Filterdata (vlax-make-variant "POLYLINE"))
(setq no-ent 1)
(while no-ent
(vla-Selectonscreen ssobj)
(if (> (vla-get-count ssobj) 0)
(progn
(setq no-ent nil)
(setq i (- 1))
(repeat (vla-get-count ssobj)
(setq
obj (vla-item ssobj
(vlax-make-variant (setq i (1+ i)))
) ;_ end of vla-item
) ;_ end of setq
(cond
((= (vlax-get-property obj "ObjectName") 3d)
(setq pl3dobj-list
(append pl3dobj-list (list obj))
) ;_ end of setq
)
) ;_ end-of cond
) ;_ end of repeat
) ;_ end of progn
(prompt "\nNo entities selected, try again.")
) ;_ end of if
(if (and (= nil no-ent) (= nil pl3dobj-list))
(progn
(setq no-ent 1)
(prompt "\nNo 3D-polylines selected.")
(quit)
) ;_ end of progn
) ;_ end of if
) ;_ end of while
(vla-delete (vla-item selsets 0))
pl3dobj-list
) ;_ end of get-3D-pline
(defun get-3D-pline-old ()
(setq no-ent 1)
(setq filter '((-4 . "<AND")
(0 . "POLYLINE")
(70 . 8)
(-4 . "AND>")
)
) ;_ end of setq
(while no-ent
(setq ss (ssget filter)
k (- 1)
pl3dobj-list nil
obj nil
3d "AcDb3dPolyline"
) ;_ end-of setq
(if ss
(progn
(setq no-ent nil)
(repeat (sslength ss)
(setq ent (ssname ss (setq k (1+ k)))
obj (vlax-ename->vla-object ent)
) ;_ end-of setq
(cond
((= (vlax-get-property obj "ObjectName") 3d)
(setq pl3dobj-list
(append pl3dobj-list (list obj))
) ;_ end of setq
)
) ;_ end-of cond
) ;_ end-of repeat
) ;_ end-of progn
(prompt "\nNo 3D-polylines selected, try again.")
) ;_ end-of if
) ;_ end-of while
pl3dobj-list
) ;_ end of get-3D-pline-old
(defun make-list (p-list)
(setq i (- 1)
vlist nil
calist nil
) ;_ end of setq
(repeat (length p-list)
(setq obj (nth (setq i (1+ i)) p-list)
coords (vlax-get-property obj "coordinates")
ca (vlax-variant-value coords)
) ;_ end-of setq
(setq calist (append calist (list ca)))
) ;_ end-of repeat
) ;_ end-of make-list
(defun c:pl32 ()
(pline-3d-2d)
(princ)
) ;_ end of pl32
(prompt "Enter PL32 to start: ")

142
ptfix.lsp Normal file
View File

@@ -0,0 +1,142 @@
;; ptfix.lsp
;;
;; Fix inaccurate points in AutoCAD with this lisp routine
;; Select the elements you want to modify, click the desired point and add a tolerance.
;; The points which are closer to the desired point than the tolerance will be moved to the desired point.
;; Video about how it works: https://www.youtube.com/watch?v=iiLdYgVTKkc
;;
;; Created by Peter Gyetvai
;; gyetpet@gmail.com
;; gyetvai-peter.hu
;;
;; massoc routine created by Jason Piercey: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/getting-multiple-assoc-values/td-p/852437
(defun massoc (key alist / x nlist)
(foreach x alist
(if (eq key (car x))
(setq nlist (cons (cdr x) nlist))
)
)
(reverse nlist)
)
(defun C:ptfix (/ ss i il imax j jl jmax currElem currTyp currPoints currPointXY goodPoint goodPointXY tolerance currDist newPoint newElem movedPoints oldMovedPoints movedElems)
;variables:
(setq i 0);counter to zero
(setq imax 1);while variable
(setq movedPoints 0)
(setq movedElems 0)
(vl-load-com)
(graphscr)
(prompt "\nSelect polylines: ")
(setq ss (ssget));asks for selection
(setq il (sslength ss));length of selection
(setq goodPoint (getpoint "\nSelect desired point: "))
(setq goodPointXY (vl-remove (last goodPoint) goodPoint))
(setq tolerance (getdist "\nTolerance?"))
(while imax
(print )
(princ "Checking element ")
(princ i)
(setq currElem (entget (ssname ss i) ))
(setq currTyp (cdr (assoc 0 currElem)))
(setq oldMovedPoints movedPoints)
(print )
(princ " Element type: ")
(princ currTyp)
(cond
(
(= currTyp "LWPOLYLINE");if polyline
(progn
(setq currPoints (massoc 10 currElem))
;; (print currPoints)
(setq jl (length currPoints))
(setq j 0);counter to zero
(setq jmax 1);while variable
(while jmax
(print )
(princ " Checking point: ")
(princ (nth j currPoints))
(setq currDist (distance (nth j currPoints) goodPointXY))
(if
(and (< currDist tolerance) (/= currDist 0))
(progn
(setq newPoint (cons 10 goodPointXY))
(setq newElem(subst newPoint (cons 10 (nth j currPoints)) currElem))
(setq currElem newElem)
(entmod newElem)
(princ " - Point moved to desired location")
(setq movedPoints (1+ movedPoints))
)
(progn
(princ " - Point is farther than tolerance")
)
)
;while specific:
(setq j (1+ j));increments i
(if (= j jl) (setq jmax nil));finish function if i equals il
)
(if (/= oldMovedPoints movedPoints) (setq movedElems (1+ movedElems)))
)
);polyline end
(
(= currTyp "LINE")
(progn
(setq j 10)
(repeat 2
(progn
(setq currPoints (cdr (assoc j currElem)))
(print )
(princ " Checking point: ")
(princ currPoints)
(setq currPointXY (vl-remove (last currPoints) currPoints))
(setq currDist (distance currPointXY goodPointXY))
(if
(and (< currDist tolerance) (/= currDist 0))
(progn
(setq newPoint (cons j goodPoint))
(setq newElem(subst newPoint (cons j currPoints) currElem))
(setq currElem newElem)
(entmod newElem)
(princ " - Point moved to desired location")
(setq movedPoints (1+ movedPoints))
)
(progn
(princ " - Point is farther than tolerance")
)
)
(setq j 11)
)
)
(if (/= oldMovedPoints movedPoints) (setq movedElems (1+ movedElems)))
)
); line end
(progn
(print )
(princ " This element is not line or polyline!")
)
)
;while specific:
(setq i (1+ i));increments i
(if (= i il) (setq imax nil));finish function if i equals il
)
(terpri)
(princ movedPoints)
(princ " point(s) moved to the desired location")
(terpri)
(princ movedElems)
(princ " element(s) modified")
(setq ss nil)
(princ)
)

63
randomRotate.lsp Normal file
View File

@@ -0,0 +1,63 @@
(defun C:randRot (/ ss i il imax maxDeg currElem currRotList currRot currRotDeg randomNumber newRotDeg newRot newRotList newElem)
;variables:
(setq i 0);counter to zero
(setq imax 1);while variable
(graphscr)
(prompt "\nselect entities to be rotated: ")
(setq ss (ssget));asks for selection
(setq il (sslength ss));length of selection
(setq maxDeg (getreal "\nMaximum degrees :"))
(while imax
(print i)
(setq currElem (entget (ssname ss i) ))
(setq currRotList (assoc 50 currElem))
(setq currRot (cdr currRotList))
(setq currRotDeg (rtd currRot))
(setq randomNumber (- (fix(* (* 2 maxDeg) (rnd))) maxDeg))
(setq newRotDeg (+ randomNumber currRotDeg))
(setq newRot (dtr newRotDeg))
(setq newRotList(cons 50 newRot))
(setq newElem(subst newRotList currRotList currElem))
;; (print currElem)
;; (print newElem)
(entmod newElem)
;while specific:
(setq i (1+ i));increments i
(if (= i il) (setq imax nil));finish function if i equals il
)
(terpri)
(setq ss nil)
)
(defun rnd (/ modulus multiplier increment random)
(if (not seed)
(setq seed (getvar "DATE"))
)
(setq modulus 65536
multiplier 25173
increment 13849
seed (rem (+ (* multiplier seed) increment) modulus)
random (/ seed modulus)
)
)
(defun dtr (a)
(* pi (/ a 180))
)
(defun rtd (a)
(/ (* a 180) pi)
)

14
scr/acadsettings.scr Normal file
View File

@@ -0,0 +1,14 @@
._taskbar
0
._FILETABTHUMBHOVER
0
._FILETABPREVIEW
0
._CURSORSIZE
100
._pickbox
6
._PROXYNOTICE
0
._PROXYSHOW
1

5
scr/bindAll.scr Normal file
View File

@@ -0,0 +1,5 @@
_.bindtype
1
_.-xref
b
*

7
scr/reloadCirc.scr Normal file
View File

@@ -0,0 +1,7 @@
-linetype
L
X-LINE
"C:\Users\gyetp\AppData\Roaming\Autodesk\AutoCAD 2018\R22.0\enu\Support\LINETYPES\AlapVonalak.lin"
regenall

16
scr/revitDwgImportCleaner.scr Normal file
View File

@@ -0,0 +1,16 @@
;version 1.0
;Run this script before importing dwg-s to Revit
;Created by Peter Gyetvai - gyetpet@gmail.com
._MODEL
._-PURGE
a
*
n
._ZOOM
e
._AUDIT
y
._-AECEXPORTTOAUTOCAD
f
2013

41
scriptpro filelists/arago 1-27.bpl Normal file
View File

@@ -0,0 +1,41 @@
[General_Start]
Version*3
Product*2011
Script*C:\Users\gyetp\Documents\_Revit families\_lisp\scr\revitCleaner.scr
TimeOut*30
RestartCount*30
IniScript*
LogFileName*
AutoCADPath*
Sleep*0
RunwithoutOpen*False
[General_End]
[DWGList_Start]
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg01 - NIVEAU -1.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg02 - NIVEAU 0.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg03 - NIVEAU 1.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg04 - NIVEAU 2.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg05 - TOITURE.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg06 - COUPE AA.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg07 - COUPE BB.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg08 - COUPE CC.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg09 - COUPE DD.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg10 - ELÉVATION NORD-EST SUR RUE.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg11 - ELÉVATION SUD-OUEST BAT A.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg12 - ELÉVATION NORD-EST BAT B.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg13 - ELÉVATION SUD-OUEST BAT B.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg14 - ELÉVATION NORD-EST BAT C.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg15 - ELÉVATION SUD-OUEST BAT C.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg16 - ELÉVATION NORD-EST BAT D.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg17 - ELÉVATION SUD-OUEST BAT D.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg18 - ELÉVATION NORD-EST BAT D ARRIERE.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg19 - ELÉVATION SUD-OUEST BAT D ARRIERE.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg20 - ELÉVATION NORD-EST BAT E.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg21 - ELÉVATION SUD-OUEST BAT E.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg22 - ELÉVATION NORD-EST BAT F.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg23 - ELÉVATION SUD-OUEST BAT F.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg24 - ELÉVATION NORD-EST BAT G.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg25 - ELÉVATION SUD-OUEST BAT G.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg26 - PIGNON NORD-EST 1_50.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg27 - PIGNON SUD-EST 1_50.dwg,1
[DWGList_End]

41
scriptpro filelists/arago 1-27_13_2_29_13_failed.bpl Normal file
View File

@@ -0,0 +1,41 @@
[General_Start]
Version*3
Product*2011
Script*C:\Users\gyetp\Documents\_Revit families\_lisp\scr\revitCleaner.scr
TimeOut*30
RestartCount*30
IniScript*
LogFileName*C:\Users\gyetp\AppData\Local\Temp\
AutoCADPath*
Sleep*0
RunwithoutOpen*False
[General_End]
[DWGList_Start]
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg01 - NIVEAU -1.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg02 - NIVEAU 0.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg03 - NIVEAU 1.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg04 - NIVEAU 2.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg05 - TOITURE.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg06 - COUPE AA.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg07 - COUPE BB.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg08 - COUPE CC.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg09 - COUPE DD.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg10 - ELÉVATION NORD-EST SUR RUE.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg11 - ELÉVATION SUD-OUEST BAT A.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg12 - ELÉVATION NORD-EST BAT B.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg13 - ELÉVATION SUD-OUEST BAT B.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg14 - ELÉVATION NORD-EST BAT C.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg15 - ELÉVATION SUD-OUEST BAT C.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg16 - ELÉVATION NORD-EST BAT D.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg17 - ELÉVATION SUD-OUEST BAT D.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg18 - ELÉVATION NORD-EST BAT D ARRIERE.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg19 - ELÉVATION SUD-OUEST BAT D ARRIERE.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg20 - ELÉVATION NORD-EST BAT E.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg21 - ELÉVATION SUD-OUEST BAT E.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg22 - ELÉVATION NORD-EST BAT F.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg23 - ELÉVATION SUD-OUEST BAT F.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg24 - ELÉVATION NORD-EST BAT G.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg25 - ELÉVATION SUD-OUEST BAT G.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg26 - PIGNON NORD-EST 1_50.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH --Sheet - dwg27 - PIGNON SUD-EST 1_50.dwg,1
[DWGList_End]

41
scriptpro filelists/arago 1-27_29_3_36_48_failed.bpl Normal file
View File

@@ -0,0 +1,41 @@
[General_Start]
Version*3
Product*2011
Script*C:\Users\gyetp\Documents\_Revit families\_lisp\scr\revitCleaner.scr
TimeOut*30
RestartCount*30
IniScript*
LogFileName*C:\Users\gyetp\AppData\Local\Temp\
AutoCADPath*
Sleep*0
RunwithoutOpen*False
[General_End]
[DWGList_Start]
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 01 - NIVEAU -1.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 02 - NIVEAU 0.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 03 - NIVEAU 1.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 04 - NIVEAU 2.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 05 - TOITURE.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 06 - COUPE AA.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 07 - COUPE BB.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 08 - COUPE CC.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 09 - COUPE DD.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 10 - ELÉVATION NORD-EST SUR RUE.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 11 - ELÉVATION SUD-OUEST BAT A.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 12 - ELÉVATION NORD-EST BAT B.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 13 - ELÉVATION SUD-OUEST BAT B.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 14 - ELÉVATION NORD-EST BAT C.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 15 - ELÉVATION SUD-OUEST BAT C.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 16 - ELÉVATION NORD-EST BAT D.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 17 - ELÉVATION SUD-OUEST BAT D.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 18 - ELÉVATION NORD-EST BAT D ARRIERE.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 19 - ELÉVATION SUD-OUEST BAT D ARRIERE.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 20 - ELÉVATION NORD-EST BAT E.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 21 - ELÉVATION SUD-OUEST BAT E.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 22 - ELÉVATION NORD-EST BAT F.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 23 - ELÉVATION SUD-OUEST BAT F.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 24 - ELÉVATION NORD-EST BAT G.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 25 - ELÉVATION SUD-OUEST BAT G.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 26 - PIGNON NORD-EST 1_50.dwg,1
C:\Users\gyetp\Documents\__dwgout\EX_ARAGO-ARCH-26-06-2018-Sheet - 27 - PIGNON SUD-EST 1_50.dwg,1
[DWGList_End]