Convert selected Circles to Polylines with option to change Width of circles


;; CirclePolylineSwap.lsp [command names: C2P & P2C]
;; Two commands, to convert in both directions between Circles and
;; circular Polylines. Both commands:
;; 1. filter User selection for only appropriate objects on unlocked Layers;
;; 2. remove selected/converted objects, but can be edited to retain them;
;; 3. account for different Coordinate Systems;
;; 4. apply selected objects' non-default and/or non-Bylayer colors, line-
;; types, linetype scales, lineweights, and/or thicknesses to conversions.
;; See additional notes above each command's definition.
;; Kent Cooper, last edited 25 February 2015

;; C2P
;; To convert selected Circle(s) to two-equal-arc-segment closed zero-
;; width Polyline circle(s) [Donut(s) w/ equal inside & outside diameters],
;; which can then be modified as desired [given width, etc.], since Pedit
;; will not accept selection of Circles to convert them.
; Slightly modified by Averbuh Igal 2017 (added option to change width of ellipses)
(defun C:C2P1 (/ *error* doc conv csel cir cdata cctr crad pdata)

(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errmsg))
); if
(vla-endundomark doc)
); defun -- *error*

(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(setq conv 0)
(prompt "\nTo convert Circle(s) to Polyline equivalent(s),")
(setq converted (ssadd))
(if (setq csel (ssget ":L" '((0 . "CIRCLE")))); User selection
(progn
(repeat (sslength csel); then
(setq
cir (ssname csel 0); Circle entity name
cdata (entget cir); entity data
cctr (cdr (assoc 10 cdata)); center point, OCS for Circle & LWPolyline w/ WCS 0,0,0 as origin
crad (cdr (assoc 40 cdata)); radius
pdata (vl-remove-if-not '(lambda (x) (member (car x) '(67 410 8 62 6 48 370 39))) cdata)
; start Polyline entity data list -- remove Circle-specific entries from
; Circle's entity data, and extrusion direction; 62 Color, 6 Linetype, 48
; LTScale, 370 LWeight, 39 Thickness present only if not default/bylayer
); setq
(entmake
(append ; add Polyline-specific entries
'((0 . "LWPOLYLINE") (100 . "AcDbEntity"))
pdata ; remaining non-entity-type-specific entries
(list
'(100 . "AcDbPolyline")
'(90 . 2); # of vertices
(cons 70 (1+ (* 128 (getvar 'plinegen)))); closed [the 1], and uses
; current linetype-generation setting; change above line to
; '(70 . 129) to force linetype generation on, '(70 . 1) to force it off
'(43 . 0.0); global width
(cons 38 (caddr cctr)); elevation in OCS above WCS origin [Z of Circle center]
(cons 10 (list (- (car cctr) crad) (cadr cctr))); vertex 1
'(40 . 0.0) '(41 . 0.0) '(42 . 1); 0 start & end widths, semi-circle bulge factor
(cons 10 (list (+ (car cctr) crad) (cadr cctr))); vertex 2
'(40 . 0.0) '(41 . 0.0) '(42 . 1)
(assoc 210 cdata) ; extr. dir. at end [if in middle, reverts to (210 0.0 0.0 1.0) in (entmake)]
); list
); append
); entmake
(ssdel cir csel)
(entdel cir); [remove or comment out this line to retain selected Circle(s)]
(ssadd (entlast) converted)
(setq conv (1+ conv))
); repeat -- then
(prompt (strcat "\n" (itoa conv) " Circle(s) converted to Polyline(s)."))
(command "select" converted "")
(sssetfirst nil converted)
(ssget "_I")
); progn -- then
(prompt "\nNo Circle(s) found [on unlocked Layer(s)]."); else
); if
(vla-endundomark doc)
(princ)
); defun

;; P2C
;; To convert selected closed all-arc-segment circular Polylines [e.g. Donuts, or
;; others if truly circular, including with more than two segments, of unequal
;; included angles, of varying widths] to true Circles. If any Polylines within
;; single selection set have non-zero global width, offers User option to draw
;; Circle along center-line or along inside or outside edge of width; applies
;; same position to all in selection, and retains choice for subsequent default.
;; Works on both old-style "heavy" 2D and newer "lightweight" Polylines.
;
(defun C:P2C
(/ *error* ptpar doc cmde conv notconv psel pl pdata ctr radlist ver plhw cpos pwadj cdata)

(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errmsg))
); if
(vla-endundomark doc)
(setvar 'cmdecho cmde)
); defun -- *error*

(defun ptpar (par); PoinT on polyline at specified PARameter value
(vlax-curve-getPointAtParam pl par)
); defun - ptpar

(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(setq
cmde (getvar 'cmdecho); for possible ConvertPoly command later
conv 0
notconv 0
); setq
(prompt "\nTo convert Polyline circle(s) to true Circle(s),")
(if (setq psel (ssget ":L" '((0 . "*POLYLINE")))); User selection
(repeat (sslength psel); then
(setq pl (ssname psel 0)); first Polyline entity name
(if
(and
(vlax-curve-isClosed pl)
(setq pdata (entget pl))
(/= (cdr (assoc 100 (reverse pdata))) "AcDb3dPolyline"); not 3D
); and
(progn ; then -- closed LW/2D Polyline
(if (= (cdr (assoc 100 (reverse pdata))) "AcDb2dPolyline"); "heavy" 2D
(progn; then
(setvar 'cmdecho 0)
(command "_.convertpoly" "_light" pl ""); retains same entity name
(setvar 'cmdecho cmde)
(setq pdata (entget pl)); replace "heavy" Polyline entity data
); progn
); if -- 2D
(if
(and
(not (member '(42 . 0.0) pdata)); no line segments
(apply '= ; all arc segments bulge in same direction [no retracing]
(mapcar 'minusp
(mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) pdata))
); mapcar
); apply
); and
(progn ; then -- check for circularity
(setq
ctr
(mapcar '/
(mapcar '+
(vlax-curve-getStartPoint pl)
(vlax-curve-getPointAtDist ; point half-way around
pl
(/
(vlax-curve-getDistAtParam pl (vlax-curve-getEndParam pl))
2.0
); /
); getPointAtDist
); mapcar +
'(2 2 2)
); mapcar \ & ctr
radlist (list (distance ctr (vlax-curve-getStartPoint pl)))
ver 0
); setq
(repeat (* (cdr (assoc 90 pdata)) 2); check distance from ctr at all vertices & midpoints
(setq rad (distance ctr (ptpar (setq ver (+ ver 0.5))))); [depends on not being "quirky"]
(if (not (equal rad (car radlist) 1e-6)); different radius?
(setq radlist (cons rad radlist)); then -- add to list
); if
); repeat
(if (= (length radlist) 1); all distances from center the same = circular -- convert it
(progn ; then
(if (assoc 43 pdata); has global width
(if ; outer then
(and
(/= (setq plhw (/ (cdr (assoc 43 pdata)) 2)) 0); PolyLine Half-Width not zero
(not cpos); not established yet -- ask only once per selection set
); and
(progn ; inner then -- get Circle-position option
(initget "Center Inside Outside")
(setq
_P2Ccpos_ ; _global_ variable
(cond
((getkword
(strcat ; will apply same User choice to ALL conversions in selection set
"\nCircle position on Donut(s) [Center/Inside/Outside] : "
); strcat
)); getkword & first condition
(_P2Ccpos_); retain on Enter if default established
("Center"); default on first use
); cond & _P2Ccpos_
cpos T ; option established for subsequent Polylines this selection
); setq
); progn -- inner then -- wide global-width Polyline -- Circle placement option
); if -- outer then [global width]
(setq plhw 0); outer else [has varying widths -- use Center]
); if [global width or not]
(setq pwadj ; = Polyline Width ADJustment
(cond ; then -- first two equivalent to "Center" for zero-width or varying-width originals
((= _P2Ccpos_ "Outside") plhw)
((= _P2Ccpos_ "Inside") (- plhw))
(0); Center option or no wide global-width originals yet
); cond
); setq
(setq cdata (vl-remove-if-not '(lambda (x) (member (car x) '(67 410 8 62 6 48 370 39))) pdata))
; build circle entity data list -- remove Polyline-specific entries from
; Polyline's entity data, and extrusion direction; 62 Color, 6 Linetype, 48
; LTScale, 370 LWeight present only if not default/bylayer; 39 Thickness
(entmake
(append ; add circle-specific entries
'((0 . "CIRCLE") (100 . "AcDbEntity"))
cdata ; remaining non-entity-type-specific entries
(list
'(100 . "AcDbCircle")
(cons 10 (trans ctr 0 pl)); center -- WCS to OCS
(cons 40 (+ (car radlist) pwadj)); radius
(assoc 210 pdata); extr. dir. at end [if in middle, reverts to (210 0.0 0.0 1.0) in (entmake)]
); list
); append
); entmake
(entdel pl)
; [remove or comment out above line to retain selected
; Polyline -- will be left lightweight if originally heavy]
(setq conv (1+ conv))
); progn -- then
(setq notconv (1+ notconv)); else -- not circular
); if -- circular
); progn -- then
(setq notconv (1+ notconv)); else -- has line segment(s) or different-direction bulge(s)
); if -- no line segments, same bulge directions
); progn -- then
(setq notconv (1+ notconv)); else -- not closed or LW/2D
); if -- closed LW/2D
(ssdel pl psel)
); repeat -- then
(prompt "\nNo Polyline(s) found [on unlocked Layer(s)]."); else
); if -- User selection
(prompt
(strcat
"\n"
(if (> conv 0) (itoa conv) "No")
" Polyline(s) converted to Circle(s). "
(if (> notconv 0)
(strcat (itoa notconv) " Polyline(s) not circular and/or not closed.")
""
); if
); strcat
); prompt
(vla-endundomark doc)
(princ)
); defun

(vl-load-com)
(prompt "\nType C2P to convert Circle(s) to equivalent Polyline(s).")
(prompt "\nType P2C to convert circular Polyline(s) to equivalent Circle(s).")

;; Polyline Width - Lee Mac
;; Applies a given constant width to all segments in a selection of polylines.

(defun c:psw ( / *error* idx sel wid )

(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
(princ (strcat "\nError: " msg))
)
(princ)
)

(LM:startundo (LM:acdoc))
(if
(setq sel (LM:ssget "\nSelect polylines: " '("P" ((0 . "LWPOLYLINE,POLYLINE")))))

(progn
(initget 4)
(setq wid (getdist (strcat "\nSpecify Width of Pline : ")))
(repeat (setq idx (sslength sel))
(vla-put-constantwidth (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) wid)
)
)
)
(*error* nil)
(princ)
)

;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)

;; 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)

(defun C:c2p ()
(setvar "osmode" 16384)

(setvar "orthomode" 0)

(c:c2p1)
(c:psw)

(setvar "osmode" 167)

(princ)
)

(c:c2p)

Convert Ellipses to Plines wth option to change width of ellipses


;Ellipses to Plines (c)1999, Oleg Khenson
;Slightly modified by Averbuh Igal 2017 (added option to change width of ellipses)

(defun C:E2P1 (/ A CEN CLA CMD DIS EN END_P1
END_P2 ENT I K LA LT M MINOR%
NM OLDERR OS PELMODE SS
)
(defun DXF (CODE ELIST) (cdr (assoc CODE ELIST)))
(defun EL2PL_ERR (S)
(if (/= S "Function cancelled")
(princ (strcat "\nError: " S))
)
(setvar "CMDECHO" CMD)
(if OS
(setvar "OSMODE" OS)
)
(setq *ERROR* OLDERR
OLDERR NIL
)
(princ)
)
(setq OLDERR *ERROR*
*ERROR* EL2PL_ERR
)
(setq CMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq converted (ssadd))
(princ "\nSelect Ellipses to be converted to PLines: ")
(setq SS (ssget '((0 . "ELLIPSE"))))
(command ".UNDO" "G")
(if SS
(progn
(setq OS (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq I 0
K 0
M 0
)
(repeat (sslength SS) ; for each entity from SS
(setq A (entget (setq NM (ssname SS I)
ENT NM
)
)
LA (DXF 8 A)
)
(if (< (cdr (assoc 70 (tblsearch "LAYER" LA))) 4)
(progn
(if (= (DXF 0 A) "ELLIPSE")
(progn
(setq LT (DXF 6 A)
CEN (DXF 10 A)
MINOR% (DXF 40 A)
END_P1 (mapcar '+ CEN (DXF 11 A))
DIS (distance CEN END_P1)
END_P2 (polar
CEN
(+ (angle CEN END_P1) (/ pi 2.0))
(* DIS MINOR%)
)
)
(setq PELMODE (getvar "PELLIPSE"))
(setvar "PELLIPSE" 1)
(setq CLA (getvar "CLAYER"))
(if (/= CLA LA)
(setvar "CLAYER" LA)
)
(command ".ELLIPSE"
"C"
(trans CEN 0 1)
(trans END_P1 0 1)
(trans END_P2 0 1)
)
(setq K (1+ K))
(setvar "PELLIPSE" PELMODE)
(entdel ENT)
(if (/= CLA (getvar "CLAYER"))
(setvar "CLAYER" CLA)
)
(if
(and LT
(/= (DXF 6 (tblsearch "LAYER" LA)) LT)
)
(progn (command ".CHPROP" "L" "" "LT" LT "")
(command ".PEDIT" "L" "L" "ON" "")
)
)
)
)
)
(setq M (1+ M))
)
(ssadd (entlast) converted)

(setq I (1+ I))

)
)
)
(command "select" converted "")

(setq *ERROR* OLDERR)
(command ".UNDO" "E")
(if OS
(setvar "OSMODE" OS)
)
(setvar "CMDECHO" CMD)
(princ)
(sssetfirst nil converted)
(ssget "_I")
)

;; Polyline Width - Lee Mac
;; Applies a given constant width to all segments in a selection of polylines.

(defun c:psw ( / *error* idx sel wid )

(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
(princ (strcat "\nError: " msg))
)
(princ)
)

(LM:startundo (LM:acdoc))
(if
(setq sel (LM:ssget "\nSelect polylines: " '("P" ((0 . "LWPOLYLINE,POLYLINE")))))

(progn
(initget 4)
(setq wid (getdist (strcat "\nSpecify Width of Pline : ")))
(repeat (setq idx (sslength sel))
(vla-put-constantwidth (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) wid)
)
)
)
(*error* nil)
(princ)
)

;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)

;; 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)

(defun C:e2p ()
(setvar "osmode" 16384)

(setvar "orthomode" 0)

(c:e2p1)
(c:psw)

(setvar "osmode" 167)

(princ)
)

(c:e2p)

Block Offset with user specified offset distance and distance between blocks


;;; Block Offset with user specified offset distance and distance between blocks
;;; Created by Igal Averbuh 2017
;;; Inspired by some subroutines of different authors

(defun C:BOF ( / pl1 pl2 bname pt1 odist)

(vl-load-com)
(cond
((and
(setq ent (car (entsel "\nSelect Block Entity: ")))
(setq bname (cdr (assoc 2 (entget ent))))
(eq (cdr (assoc 0 (entget ent))) "INSERT")
(princ (strcat "Block Name:"
(vla-get-effectivename
(vlax-ename->vla-object ent)))))

))

; (setq bname (getstring "\nType Block name: "))
(setq pl1 (car (entsel "\nSelect polyline: ")))
(setq pt1 (getpoint "\nPick side to offset to: "))
(setq odist (getdist pt1 "\nDistance to offset polyline:"))
(setq odist1 (getdist pt1 "\nDistance to offset Block:"))
(command "_offset" odist pl1 pt1 "")
(setq pl2 (entlast))
(command "_measure" pl2 "_b" bname "_y" odist1)
)
(c:bof)

Draw Grid Axes with axes numbering


; This function automates horizontal & vertical column grid lines at specified
; offsets. A column line bubble with number or letter is placed at the end of
; each centerline. Numbers or letters are sequentially incremented at each
; centerline. Dimension is performed between each column line.
; The orientation is bubbles on top and to the left of centerlines.
; Offsets top to bottom and left to right.
; Orginal program by Jeff Burner
; Slightly modified by Igal Averbuh 2017 (added option to set needful data by 2 points on screen)

(defun c:cg ()
(alert "Need to disable WinHEB in order to use this routine properly")
(setvar 'TEXTSIZE
(cond ((getdist (strcat "\nSpecify Text Height by 2 points : ")))
((getvar 'TEXTSIZE))
)
)

(setq CE (getvar "CMDECHO")
OM (getvar "ORTHOMODE")
TS (getvar "TEXTSIZE")
TH (rtos TS)
)

(setvar "CMDECHO" 0)
(setvar "ORTHOMODE" 0)
(if TS
(progn
(setq TXTHT (strcat "\nText Height: "))
(setq THT (atof (getstring TXTHT)))
(if (= THT 0.0) (setq STTXT TS) (setq STTXT THT))
)
)
(setq P1 (getpoint "\nEnter upper left grid intersection: "))
(setq XBAYN (getint "\nEnter no. of horizontal axes: "))
(setq YBAYN (getint "\nEnter no. of vertical axes: "))
(setq XBAYZ (getdist "\nEnter horizontal distance between axes: "))
(setq YBAYZ (getdist "\nEnter vertical distance between axes: "))
(setq DIR (* STTXT 3))
(setq RAD STTXT)
(setq XLEN (+ 192 (* YBAYZ YBAYN)))
(setq YLEN (+ 192 (* XBAYZ XBAYN)))
(setq XNUM 1)
(setq XP2 (list (car P1) (+ 96 (cadr P1))))
(setq XP3 (list (car XP2) (+ (/ DIR 2) (cadr XP2))))
(setq XP4 (list (car XP2) (+ DIR (cadr XP2))))
(setq XP5 (list (car XP2) (- (cadr XP2) XLEN)))
(command "TEXT" "M" XP3 STTXT "0" (rtos XNUM 2 0))
(command)
(command "CIRCLE" "2P" XP2 XP4)
(command "LINE" XP2 XP5 "")
(command "change" "L" "" "P" "LT" "center" "")
(setq XINSTR XBAYZ)
(while (/= XBAYN 0.0)
(command "dim" "hor" (list (car XP2) (- (cadr XP2) RAD))
(list (+ (car XP2) XINSTR) (- (cadr XP2) RAD))
(list (+ (car XP2) XINSTR) (- (cadr XP2) RAD)) ""
)
(command)
(setq XP2 (list (+ (car XP2) XINSTR) (cadr XP2)))
(setq XP3 (list (car XP2) (+ (/ DIR 2) (cadr XP2))))
(setq XP4 (list (car XP2) (+ DIR (cadr XP2))))
(setq XP5 (list (car XP2) (- (cadr XP2) XLEN)))
(setq XNUM (+ XNUM 1))
(command "TEXT" "M" XP3 STTXT "0" (rtos XNUM 2 0))
(command)
(command "CIRCLE" "2P" XP2 XP4)
(command "LINE" XP2 XP5 "")
(command "change" "L" "" "P" "LT" "center" "")
(setq XBAYN (- XBAYN 1))
)
(command)
(setq YNUM 65)
(setq LETR (chr YNUM))
(setq YP2 (list (- (car P1) 96) (cadr P1)))
(setq YP3 (list (- (car YP2) (/ DIR 2)) (cadr YP2)))
(setq YP4 (list (- (car YP2) DIR) (cadr YP2)))
(setq YP5 (list (+ (car YP2) YLEN) (cadr YP2)))
(command "TEXT" "M" YP3 STTXT "0" LETR)
(command)
(command "CIRCLE" "2P" YP2 YP4)
(command "LINE" YP2 YP5 "")
(command "change" "L" "" "P" "LT" "center" "")
(setq YINSTR YBAYZ)
(while (/= YBAYN 0.0)
(command "dim" "vert" (list (+ (car YP2) RAD) (cadr YP2))
(list (+ (car YP2) RAD) (- (cadr YP2) YINSTR))
(list (+ (car YP2) RAD) (- (cadr YP2) YINSTR)) ""
)
(command)
(setq YP2 (list (car YP2) (- (cadr YP2) YINSTR)))
(setq YP3 (list (- (car YP2) (/ DIR 2)) (cadr YP2)))
(setq YP4 (list (- (car YP2) DIR) (cadr YP2)))
(setq YP5 (list (+ (car YP2) YLEN) (cadr YP2)))
(setq YNUM (+ YNUM 1))
(if (= YNUM 73) (setq YNUM 74))
(setq LETR (chr YNUM))
(command "TEXT" "M" YP3 STTXT "0" LETR)
(command)
(command "CIRCLE" "2P" YP2 YP4)
(command "LINE" YP2 YP5 "")
(command "change" "L" "" "P" "LT" "center" "")
(setq YBAYN (- YBAYN 1))
)
(command)
(princ)
(setvar "ORTHOMODE" OM)
(setvar "CMDECHO" CE)
)
(c:cg)

Offset selected Texts and Mtexts to orthogonal directions with user specified distance


;;; Offset selected Texts and Mtexts to orthogonal directions with user specified distance
;;; Created by Tharwat 17. 06. 2011
;;; Saved from: http://www.cadtutor.net/forum/archive/index.php/t-60238.html?s=b89acc4f7788518cdf276f1576bb2791

(defun c:tof (/ ss rep dis i ssNme p)
(vl-load-com)
; Tharwat 17. 06. 2011
(if
(and (setq ss (ssget "_:L" '((0 . "TEXT,MTEXT"))))
(progn (initget "Left Right Up Down")
(setq rep
(getkword "\n Specify the Direction [Left/Right/Up/Down]:"
)
)
)
(setq dis (getdist "\n Specify the Distance :"))
)
(cond ((eq rep "Left")
(repeat
(setq i (sslength ss))
(setq ssNme (ssname ss (setq i (1- i))))
(vla-move
(vlax-ename->vla-object ssNme)
(vlax-3d-point (setq p (cdr (assoc 10 (entget ssNme)))))
(vlax-3d-point (list (- (car p) dis) (cadr p)))
)
)
)
((eq rep "Right")
(repeat
(setq i (sslength ss))
(setq ssNme (ssname ss (setq i (1- i))))
(vla-move
(vlax-ename->vla-object ssNme)
(vlax-3d-point (setq p (cdr (assoc 10 (entget ssNme)))))
(vlax-3d-point (list (+ (car p) dis) (cadr p)))
)
)
)
((eq rep "Up")
(repeat
(setq i (sslength ss))
(setq ssNme (ssname ss (setq i (1- i))))
(vla-move
(vlax-ename->vla-object ssNme)
(vlax-3d-point (setq p (cdr (assoc 10 (entget ssNme)))))
(vlax-3d-point
(list (car p) (+ (cadr p) dis))
)
)
)
)
((eq rep "Down")
(repeat
(setq i (sslength ss))
(setq ssNme (ssname ss (setq i (1- i))))
(vla-move
(vlax-ename->vla-object ssNme)
(vlax-3d-point (setq p (cdr (assoc 10 (entget ssNme)))))
(vlax-3d-point
(list (car p) (- (cadr p) dis))
)
)
)
)
)
(princ)
)
(princ)
)
(c:tof)

Using Wildcards in the FIND and Replace in AutoCAD

Using Wildcards in the FIND and Replace in AutoCAD


Since my last Blog was about Text features in AutoCAD, I recently got a support request from one of our clients that made us have to stop and scratch our heads for a minute on the capabilities of using the Find/Replace command with wildcards in AutoCAD. It seemed that in some cases the text would not me found and in others we would lose valuable information. So, after several trial and errors we finally were able to get the command to accomplish what the client needed (and after losing a few hair follicles along the way too!). So I thought this was a perfect time to add to last month’s Blog; so I wanted to share my findings with you…


First let me set the stage of what the customer wanted to do.
They had an AutoCAD Structural drawing with Mtext calling out the member sizes and some of them with the quantities if there were multiple beams, obviously to avoid unnecessary duplication and better drawing clarity. The naming convention was standard (i.e. W12X18 [24]) which denotes a Wide-flange beam 12” by 18” and a total count of 24 beams and so on.

Mission: The drawing consisted of hundreds of beam callouts that needed to be modified to only show the quantities and not the beam size. But beams without quantities needed to be left alone.

1

Note: This is a super small portion of the drawing just to show an example.

Solution: Find and Replace with Wildcards. Now the trick only works character by character, so with that said there are differences in the text (example. W8X16 Vs W16X24 has a different number of place holders.) And some of the callouts do not include a quantities so we don’t want to lose those callouts either, so logically we will have to work through several steps to address each scenario, as well as there are certain other things to be aware of to avoid making mistakes that the user could be unaware of.

Operation: In AutoCAD enter the FIND command, the FIND and Replace Dialog if you type in the following bold text in the Find field box.

W?X?? 

The results will find anything that starts with a W and any single character after (The 2nd Character place holder) and the 3rd character has to be an X, then it will accept any characters after, but only the next 2 characters that follow the X will remain if you replace with nothing. (Meaning a voided blank box, not even a space) in the Replace field. Below I created a Matrix Chart  and summary for the client so they can easily; know what to enter in the find and know what the results of the changes would be.

FIND and Replace Results

With FIND, you can use several wild-card characters to broaden your search. Here is a list of the Character’s and their Definitions…

# (Pound)

Matches any numeric digit

 

@ (At)

Matches any alphabetic character

 

. (Period)

Matches any nonalphanumeric character

 

* (Asterisk)

Matches any string and can be used anywhere in the search string

 

? (Question mark)

Matches any single character; for example, ?BC matches ABC, 3BC, and so on

 

~ (Tilde)

Matches anything but the pattern; for example; ~*AB*matches all strings

that don’t contain AB

 

[ ]

Matches any one of the characters enclosed; for example, [AB]C matches

AC and BC

 

[~]

Matches any character not enclosed; for example, [~AB]C matches XC but

not AC

 

[-]

Specifies a range for a single character; for example, [A-G]C matches

AC, BC, and so on to GC, but not HC

 

` (Reverse quote)

Reads the next character literally; for example, `~AB matches ~AB

I hope this is useful information for you. I know that the Find command is one of the commands that most people forget about… So the next time you need to change a lot of text in your AutoCAD drawing, and if you know these tricks, it will drastically speed up the process… Now that is a FIND!!!

How to make AutoCAD Open Faster and Run Faster

How to make AutoCAD Open Faster and Run Faster


A common goal for every AutoCAD user is to get the best performance out of your AutoCAD software. And some of the old tricks still hold true today–they are just done a little bit differently in the newer versions.

So, I thought I would take some time and show everyone how some of some old tricks that help AutoCAD run faster.

Reducing the Amount of Content to Load When Starting AutoCAD

Right-click on the AutoCAD desktop Icon and click Properties.

autocad properties
Click lick in the short and add the switch “/nologo” at the end of the line in the Target field.

Example: “C:\Program Files\Autodesk\AutoCAD 2017\acad.exe” /product ACAD /language “en-US” /nologo

Click Apply at the bottom. (You will need to have administrator permission to do this)

properties dialog box

Click OK to exit the properties dialog box.

autocad properties shortcut
Setting the Priority in the Task Manager

Launch AutoCAD so the executable displays in the Task Manager.

Right-click on the Window’s start icon and open the Task Manager.

 

autocad task manager

Click on the Details Tab.

Right-click on the ACAD.EXE file.

Click the Set Priority.

Select Realtime option.

Close the Task Manager by clicking the X in the upper-right corner of the dialog.

autocad task manager x
Setting the Hardware Acceleration

Open AutoCAD and check the Hardware Acceleration icon to see if it is ON.

hardware acceleration off vs hardware acceleration on

 

(If OFF, follow the steps below to turn it ON)

graphics performance

Right-click on the Hardware Acceleration icon and pick the [Graphics Performance] shortcut menu.

graphics performance shortcut menu

Other ways you can test to see if you are getting the best performance is to test some of the settings by turning them on and off.

For example: Open the Hardware Acceleration the same way you did in the last Item. You can also view the Tuner Log.

tuner log
Additional Notes from the AutoCAD Help file:

Graphics performance tuning examines your graphics card and 3D display driver and determines whether to use software or hardware acceleration.

Features that might not work properly on your system are turned off. Some features might work with your hardware, but are not recommended because the graphics card or 3D graphics display driver that you are using did not pass the Autodesk certification process or was not tested. Features can be enabled at your own risk.

The tuner log reports which graphics card and 3D display driver were identified on your system and whether hardware effects are enabled. The Effects section displays the current state of the supported hardware effects of the current display driver.

The log file displays information about the current application driver, as well as available application drivers and supported effects. Use this information to determine whether it’s better to use an application driver for your graphics card or the software driver.

To display mapped object shadows in viewports and to use per-pixel lighting, hardware acceleration is required.

When Uncompressed Textures is turned on, the amount of video memory required to open a drawing that contains materials that utilize images is increased.

By using this effect, it may decrease the time to load the images the first time that they are accessed, but the downside is it can increase the amount of video memory necessary to display the drawing. Also, there is a reduction in the quality of the images when they are displayed.

Finally, always make sure that your Hardware (including Graphics Card) is tested and Certified by Autodesk.

And when it comes to RAM, more is always better!

Remember, the recommend amount is just to run the software, not your business!

Send all IMAGES, OLE’s and PDF’s to back in one click


;;; Send all IMAGES, OLE's and PDF's to back in one click
;;; Created by Willie https://www.theswamp.org/index.php?action=profile;u=1474
;;; Saved from here: https://www.theswamp.org/index.php?topic=52967.0
;;; Slightly modified by Igal Averbuh 2017 (added option for PDF's and OLE's)

(defun c:HAB (/)
(setvar "cmdecho" 0)
(setq SS_IMAGE nil)
(setq SS_IMAGE (ssget "X" '((0 . "IMAGE,OLE2FRAME,PDFUNDERLAY"))))
(if (= SS_IMAGE nil)
(princ "\nNo images in drawing")

(progn
(command "draworder" SS_IMAGE "" "back" )
(setvar "cmdecho" 1)

(princ "\n *** All IMAGES, OLE's and PDF's moved to back !! ***")

);progn
);if
(princ)
);defun
(c:hab)

Delete all dimensions in the all blocks


(defun c:dim (/ ss i sn name lst)
(vl-load-com)
;;; ------ Tharwat 15. June. 2012 ----- ;;;
;;; codes to delete all dimensions entities in the ;;;
;;; all blocks ;;;
(if (not acdoc)
(setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
)
(if (setq ss (ssget "X" '((0 . "INSERT"))))
(repeat (setq i (sslength ss))
(setq sn (ssname ss (setq i (1- i))))
(if (not (member (setq name (cdr (assoc 2 (entget sn)))) lst))
(progn
(setq lst (cons name lst))
(vlax-for each (vla-item (vla-get-blocks acdoc) name)
(if (eq (vla-get-objectname each) "AcDbRotatedDimension")
(vla-delete each))
)
)
)
)
(princ)
)
(if ss (vla-regen acdoc AcAllviewports))
(princ)
)
(c:dim)

Delete all dimensions in the selected blocks

 
(defun c:dim (/ ss i sn name lst)
(vl-load-com)
;;; ------ Tharwat 15. June. 2012 ----- ;;;
;;; codes to delete all dimensions entities in the ;;;
;;; all blocks ;;;
(if (not acdoc)
(setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
)
(if (setq ss (ssget "_:L" '((0 . "INSERT"))))
(repeat (setq i (sslength ss))
(setq sn (ssname ss (setq i (1- i))))
(if (not (member (setq name (cdr (assoc 2 (entget sn)))) lst))
(progn
(setq lst (cons name lst))
(vlax-for each (vla-item (vla-get-blocks acdoc) name)
(if (eq (vla-get-objectname each) "AcDbRotatedDimension")
(vla-delete each))
)
)
)
)
(princ)
)
(if ss (vla-regen acdoc AcAllviewports))
(princ)
)
(c:dim)