AutoLISP: ReOrder Polyline Origin

Taking into consideration the previous posts about determining the origin of a closed polyline, Finding the direction of a polyline and being aware that the REVERSE command will change the origin of a closed polyline – the LISP file in this post will help you have control of defining the “Origin” or first vertex of a polyline. And as a bonus, it even works on 3D Polylines.

Here’s how:

  • Load the lisp file
  • REORDERPOLY [enter]
  • Select the polyline
  • Click an endpoint to define the new origin

ReOrder Polyline Origin

 

3D Polyline shown below

 

ReOrderPoly 3D Poly


;;; T Willey
;;; Re Order Polyline Origin
;;; http://www.theswamp.org/index.php?topic=12624.msg154976#msg154976
(defun c:ReOrderPoly (/ Sel Pt Pobj EntData Ptype PtList VertexPt PtListIndex StWd EndWd PolyList OldIndex StPos cnt
                        tmpList ShouldClose)

(vl-load-com)
(defun ChangeOldStyle (Ent Pt / Pent cnt EntData PolyInfoList StPos StPt ShouldClose)

(setq Pent Ent)
(setq cnt 0)
(while
 (and
  (setq Ent (entnext Ent))
  (setq EntData (entget Ent))
  (= (cdr (assoc 0 EntData)) "VERTEX")
 )
 (setq PolyInfoList
  (cons
   (list
    cnt
    (cdr (assoc 10 EntData))
    (cdr (assoc 42 EntData))
    (cdr (assoc 40 EntData))
    (cdr (assoc 41 EntData))
   )
   PolyInfoList
  )
 )
 (if (equal cnt 0)
  (setq StPt (cdr (assoc 10 EntData)))
 )
 (setq cnt (1+ cnt))
 (setq ShouldClose (equal StPt (cdr (assoc 10 EntData)) 0.0001))
)
(foreach Lst PolyInfoList
 (if (equal Pt (cadr Lst))
  (setq OldIndex (car Lst))
 )
)
(setq PolyInfoList (reverse PolyInfoList))
(setq StPos (vl-position (assoc OldIndex PolyInfoList) PolyInfoList))
(setq cnt StPos)
(setq Ent Pent)
(while
 (and
  (setq Ent (entnext Ent))
  (setq EntData (entget Ent))
  (= (cdr (assoc 0 EntData)) "VERTEX")
 )
 (setq EntData (subst (cons 10 (cadr (nth cnt PolyInfoList))) (assoc 10 EntData) EntData))
 (setq EntData (subst (cons 42 (caddr (nth cnt PolyInfoList))) (assoc 42 EntData) EntData))
 (setq EntData (subst (cons 40 (cadddr (nth cnt PolyInfoList))) (assoc 40 EntData) EntData))
 (setq EntData (subst (cons 41 (last (nth cnt PolyInfoList))) (assoc 41 EntData) EntData))
 (entmod EntData)
 (setq cnt (1+ cnt))
 (if (> cnt (1- (length PolyInfoList)))
  (setq cnt 0)
 )
)
(if ShouldClose
 (progn
  (setq EntData (entget Pent))
  (entmod (subst '(70 . 1) (assoc 70 EntData) EntData))
 )
)
(entupd Pent)
)
;-----------------------------------------------------------
(command "_.undo" "_end")
(command "_.undo" "_group")
(if
 (and
  (setq Sel (entsel "\n Select polyline: "))
  (setq Pt (getpoint "\n Select new starting point: "))
  (setq Pobj (vlax-ename->vla-object (car Sel)))
  (setq EntData (entget (car Sel)))
  (wcmatch (setq Ptype (cdr (assoc 0 EntData))) "*POLYLINE")
 )
 (if (= Ptype "POLYLINE")
  (ChangeOldStyle (car Sel) Pt)
  (progn
   (setq PtList (vlax-get Pobj 'Coordinates))
   (if
    (and
     (= (vla-get-Closed Pobj) :vlax-false)
     (equal (car PtList) (nth (- (length PtList) 2) PtList) 0.0001)
     (equal (cadr PtList) (last PtList) 0.0001)
    )
    (setq ShouldClose T)
   )
   (setq VertexPt 0)
   (setq PtListIndex 0)
   (repeat (/ (length PtList) 2)
    (vla-GetWidth Pobj VerTexPt 'StWd 'EndWd)
    (setq PolyList
     (cons
      (list
       VertexPt
       (list
        (nth PtListIndex PtList)
        (nth (1+ PtListIndex) PtList)
       )
       (vla-GetBulge Pobj VertexPt)
       StWd
       EndWd
      )
      PolyList
     )
    )
    (setq VertexPt (1+ VertexPt))
    (setq PtListIndex (+ 2 PtListIndex))
   )
   (foreach Lst PolyList
    (if (equal (list (car Pt) (cadr Pt)) (cadr Lst))
     (setq OldIndex (car Lst))
    )
   )
   (setq VertexPt 0)
   (setq PtList nil)
   (setq PolyList (reverse PolyList))
   (setq StPos (vl-position (assoc OldIndex PolyList) PolyList))
   (setq cnt StPos)
   (repeat (length PolyList)
    (setq tmpList (nth cnt PolyList))
    (setq PtList (append PtList (cadr tmpList)))
    (vla-SetBulge Pobj VertexPt (caddr tmpList))
    (vla-SetWidth Pobj VertexPt (cadddr tmpList) (last tmpList))
    (setq VertexPt (1+ VertexPt))
    (setq cnt (1+ cnt))
    (if (> cnt (1- (length PolyList)))
     (setq cnt 0)
    )
   )
   (vlax-put Pobj 'Coordinates PtList)
   (if ShouldClose
    (vla-put-Closed Pobj :vlax-true)
   )
  )
 )
)
(command "_.undo" "_end")
(princ)
)

[\code]

Posted in AutoLISP, AutoLISP: Modify, AutoLISP: Polylines, Polylines | Leave a comment

Reverse Polyline Moves Origin

Today’s tip is more of a “head’s up” to be aware of when using the REVERSE command on a closed polyline.

The Reverse command will reverse the direction of selected objects. What is reversed is the direction or the order of the way that the objects were drawn.

You can use the command REVERSE to launch this command or it is located on the ribbon on the Home tab > Modify Panel > Reverse (shown below)

Reverse Command on Ribbon

 

You can find the “origin” of a polyline by selecting the polyline, then right-click and select “Properties” to open the properties palette.

Click inside “Current Vertex” section of the palette. The first vertex will have a temporary marker “X” on-screen at the “origin.”

Polyline Vertex Reverse 1

 

When you click on the up or down arrows of the “Current Vertex” section, you will see the direction of the polyline. clicking the Up arrows will show the direction in which the polyline was created. Clicking down will go backwards…

Polyline Vertex 3 initial direction

 

when using the Reverse command so that the direction is changed, note that the origin changes on closed polylines. This may not be a big deal for most situations but there are instances when each vertex is included in a report and its coordinates are included in the report. And maybe the person who drew the polyline drew the polyline in the wrong direction. Hopefully, this can be corrected by using the REVERSE command.

Below is the polyline as shown above and its origin after the reverse command is used on it. Notice that the origin changes.

Polyline Vertex Reverse 2

 

Polyline Vertex 4 After REVERSE command

Posted in Modifying, Polylines, TIPS | 1 Comment

AutoLISP: Polyline Direction preview

The simplicity of this routine is why I like it so much. You simply run the command and then select a polyline and it displays temporary arrows that show the direction of the polyline. Once you either zoom in or out, or even use RE [enter] for a REGEN, the temporary arrows will stop displaying.

All credit goes to Luis Esquival and RonJon from the.swamp.org for sharing and editing this routine.

Below – Various polylines have their directions shown

PolyLine Direction

As an extra bonus, this routine works on 3DPOLYLINEs. Even though the arrows aren’t exactly aligned, it is still nice to have a way to show the direction…

PolyLine Direction 3DPOLY

~enjoy


;; Original Code by Luis Esquival http://www.theswamp.org/index.php?topic=9441.msg169894#msg169894
;; Displays the direction of polylines with temporary arrows
;;
;; Modified by RonJonP
;; http://www.theswamp.org/index.php?topic=35706.msg409414#msg409414
(vl-load-com)
(defun getarcsegment (cen r fromvertex p2 / a1 a2 d)
  (if (and fromvertex p2)
    (progn (setq a1 (angle cen fromvertex)
		 a2 (angle cen p2)
	   )
	   (if (or (< a1 a2) (equal a1 a2 0.001))
	     (setq d (* r (- a2 a1)))
	     (setq d (* r (- (+ 6.2831853 a2) a1)))
	   )
    )
    ;; is a circle
    (setq d (* r 6.2831853))
  )
)

(defun getbulgedata (bulge fromvertex p2 / dir theta beta radio dat)
  (setq	dir   (cond ((minusp bulge) -1.0)
		    (t 1.0)
	      )
	theta (* 4.0 (atan (abs bulge)))
  )
  (if (> theta pi)
    (setq theta	(- (* 2.0 pi) theta)
	  dir	(* -1.0 dir)
    )
  )
  (setq	theta (/ theta 2.0)
	radio (abs (/ (distance fromvertex p2) (* 2.0 (abs (sin theta)))))
	beta  (+ (angle fromvertex p2) (* (- (/ pi 2.0) theta) dir))
	pc    (polar fromvertex beta radio)
  )
  (getarcsegment pc radio p2 fromvertex)
)

(defun getlwpolydata
       (vla_poly / name endparam param closed fromvertex p2 midp bulge vlist)
  (setq closed (vla-get-closed vla_poly))
  (setq endparam (vlax-curve-getendparam vla_poly))
  (setq param endparam)
  (setq i 0)
  (while (> param 0)
    (setq param (1- param))
    (setq fromvertex (vlax-curve-getpointatparam vla_poly i))
    (if	(vlax-property-available-p vla_poly 'bulge)
      (setq bulge (vla-getbulge vla_poly (fix i)))
    )
    (setq nextvertex (vlax-curve-getpointatparam vla_poly (+ i 1)))
    (setq dis (distance fromvertex nextvertex))
    (setq midpt (vlax-curve-getpointatparam vla_poly (+ i 0.5)))
    (if	(and bulge (not (zerop bulge)))
      (progn (setq bulge (getbulgedata bulge fromvertex nextvertex))
	     (setq etype "ARC")
      )
      (progn bulge (setq etype "LINE"))
    )
;;;;;;    (if	(not :rcmPrefixArcText)
;;;;;;      (setq :rcmPrefixArcText "L="))
    (setq vlist	(cons (list ;; vertex number
			    (+ i 1)
			    ;; object type
			    etype
			    ;; midpoint
			    midpt
			    ;; start vertex
			    fromvertex
			    ;; ending vertex
			    nextvertex
			    ;; curved or straight length
;;;;;;	       (if (= eType "ARC")
;;;;;;		 (strcat
;;;;;;		   :rcmPrefixArcText
;;;;;;		   (rtos bulge (rcmd-getUnits-mode) :rcmPrec))
;;;;;;		 ;; is straight
;;;;;;		 (rtos dis (rcmd-getUnits-mode) :rcmPrec))
		      )
		      vlist
		)
    )
    (setq i (1+ i))
  )
  (reverse vlist)
)

(defun dib_flechdir (lst_dat / unidad angf dirf pfm pf1 pf2 pf3 pf4 pftemp)
  ;; set arrow length according to screen height
  ;; to draw the same arrows at any level of zoom
  (setq unidad (/ (getvar "VIEWSIZE") 15))
  (foreach dat lst_dat
    (setq angf (cadr dat)
	  dirf (caddr dat)
	  pfm  (polar (car dat) (+ angf (/ pi 2)) (* unidad 0.3))
	  pf1  (polar pfm (- angf pi) (/ unidad 2.0))
	  pf2  (polar pfm angf (/ unidad 2.0))
    )
    (if	(= dirf 1)
      (setq pf3	(polar pf2 (- angf (/ (* pi 5.0) 6.0)) (/ unidad 4.0))
	    pf4	(polar pf2 (+ angf (/ (* pi 5.0) 6.0)) (/ unidad 4.0))
      )
      (setq pftemp pf1
	    pf1	   pf2
	    pf2	   pftemp
	    pf3	   (polar pf2 (+ angf (/ pi 6.0)) (/ unidad 4.0))
	    pf4	   (polar pf2 (- angf (/ pi 6.0)) (/ unidad 4.0))
      )
    )
    (if	flag_dir
      (progn ;; draw green arrow
	     ;; when you are changing direction
	     (grdraw pf1 pf2 3)
	     (grdraw pf2 pf3 3)
	     (grdraw pf2 pf4 3)
      )
      (progn ;; draw arrow
	     (grdraw pf1 pf2 4)
	     (grdraw pf2 pf3 4)
	     (grdraw pf2 pf4 4)
      )
    )
  )
  (setq flag_dir nil)
)

;;; Command for test...
(defun c:PLD (/ pol obj pol_data)
  (setq	pol	 (car (entsel "\nSelect polyline: "))
	obj	 (vlax-ename->vla-object pol)
	pol_data (getlwpolydata obj)
  )
  (dib_flechdir
    (setq lst_dat
	   (vl-remove
	     nil
	     (mapcar (function (lambda (i)
				 (if (nth 2 i)
				   (list (nth 2 i) (angle (nth 3 i) (nth 4 i)) 1)
				 )
			       )
		     )
		     pol_data
	     )
	   )
    )
  )
  (princ)
)
Posted in AutoLISP, AutoLISP: Polylines, Polylines, TIPS | 2 Comments

Helpful Settings for Plotting 3D Solids in AutoCAD

This post isn’t a fix-all solution but it has helped printing/plotting issues that I’ve recently encountered. There are some helpful AutoCAD variables and an adjustment to your preferred “Visual style(s)” that can help make printing 3D solids look correct in your print.

First – The issue that we encountered was that intersecting solids didn’t have a clear intersection in the print and curved 3D objects were displaying lines where a “tessellation” of the curves would be.

print Settings for Solids 1a

The settings of the visual styles for a viewport can be confusing. Note that there is a difference of a “Visual Style” and “Shade Plot” setting. This trips me up a lot and I confuse them for each other…

For the purposes of this blog post, I will keep it simple and keep the visual style of the Viewport set to “2D Wireframe” (shown below)

Print Settings for solids 2 1a

  • Then change the “Shade Plot” setting of the viewport by selecting the edge of the viewport from paper space and opening the “Properties” palette. (right-click > Properties)
  • Change “Shade Plot” from “As Displayed” to “Hidden”

Print Settings for Solids 2 a

Change the Visual Style to not display the “Isolines”
Use the command VISUALSTYLES in the command line to open the Visual Styles palette.

  1. Select the Visual Style that you wish to change in the upper section of the palette. In this example, I changed the “Hidden” Visual Style.
  2. Scroll down in the palette to the “Edge Settings” section, Change the property called “Show” from “Facet Edges” to “Isolines
  3. Change the “Number of Lines” setting from “20” to “0” (zero).

Print Settings for Solids 2 b

 

In addition to making this change to the Vistual Style, changing the following AutoCAD variables helps the plot to display correctly.

Print Settings for Solids 3

 

The result is shown below. Hopefully you find this useful.

Print Settings for Solids 4

Posted in Layout, Paper Space, PDF, Printing - Plotting, TIPS | Leave a comment

AutoLISP: Updated Join Dimensions for AutoCAD 2014 & 2015

I was made aware that the Join Dimensions routine previously posted [here] wasn’t working for AutoCAD 2014 & 2015 so here is an updated version.

Here’s how:

  • After loading JDIMS [enter] to start
  • Select the first dimension
  • Select the second dimension

Note: the two dimesnions have to be the same type of dimension (either both Aligned or both Rotated…)

JDIMS for 2014 & 2015

 


;Shusei Hayashi
;OffshoreCad&Management Inc.
;10F Jaka Bldg., 6780 Ayala Ave.,
;Makati, Philippines
;http://www.offshorecad.com.ph/
;http://www.offshore-management.com.ph/
; Slightly modified to work with AutoCAD 2014 & 2015
; Greg Battin www.autocadtips.wordpress.com
; 

(defun c:JDIMS( /  Flag ObjName1 ObjName2 Ang Ang2 Pt1 Pt2 Pt3 Pt4)
	(princ "\n convert two dimensions to total Dimension on the same position")
	(princ "\n **********************************")
	(setq *error* *myerror*)   
	(SD1028)
	(setq LegLen 7.0)
	(setq Flag nil)
	(get_layer&ltype&color)
	(RegistryRead_1001)
	(setvar "Clayer" Lay1)
	(setvar "Cecolor" Col1)
	(setvar "Celtype" LT1)
	(while (= Flag nil)
	   (setq ObjName1 (car (entsel "\n Select 1st Dimension :")))
		(if (and ObjName1(= (cdr (assoc 0 (setq Data1 (entget ObjName1)))) "DIMENSION"))
			(setq Flag T)
		)
	)
	(redraw ObjName1 3)
	(setq theStyle (SD3511 3 ObjName1))
	(setq Flag nil)
	(while (= Flag nil)
		(setq ObjName2 (car (entsel "\n Select 2nd Dimension :")))
		(if 	(and 	ObjName2 
				(= (cdr (assoc 0 (setq Data2 (entget ObjName2)))) "DIMENSION")
				(or	(equal (abs (- (cdr (assoc 50 Data1))(cdr (assoc 50 Data2)))) 0.0 0.0001)
					(equal (abs (- (cdr (assoc 50 Data1))(cdr (assoc 50 Data2)))) pi 0.0001)
				)
			)
			(setq Flag T)
				(princ "\n two dimensions should have same angle")
		)
	)
	(redraw ObjName1 4)
	
	;
	(setq PList (list (cdr (assoc 13 Data1))(cdr (assoc 14 Data1))(cdr (assoc 13 Data2))(cdr (assoc 14 Data2))))
	;
	(setq PList2 (list (cdr (assoc 10 Data1)) (cdr (assoc 10 Data2))))
	;
	(if (/= (distance (cdr (assoc 14 Data1))(cdr (assoc 10 Data1))) 0)
		(setq Ang (angle (cdr (assoc 14 Data1))(cdr (assoc 10 Data1))))
		(setq Ang (+ (angle (cdr (assoc 13 Data1))(cdr (assoc 14 Data1))) (* 0.5 pi)))
	)
	
	(setq Ang2 (+ Ang (* -0.5 pi)))
	;ƒŒƒCƒ„[
	(setq ItsLayer (cdr (assoc 8 Data1)))
	
	;
	(setq PList_n (mapcar '(lambda(x)(SD1862 x Ang2))PList))
	(setq PList2_n (mapcar '(lambda(x)(SD1862 x Ang2))PList2))
	;
	(setq PList_n_x (mapcar 'car PList_n))
	;
	(setq PList2_n_y (mapcar 'cadr PList2_n))
	
	;
	(setq Position1 (vl-position (apply 'min PList_n_x) PList_n_x))
	
	(setq Position2 (vl-position (apply 'max PList_n_x) PList_n_x))
	;
	(setq Position3 (vl-position (apply 'max PList2_n_y) PList2_n_y))
	
	
	(setq Pt1 (nth Position1 PList))
;	(checkcircle Pt1 1.0 "A21")
	(setq Pt2 (nth Position2 PList))
;	(checkcircle Pt2 1.0 "A31")
	(setq Pt3 (nth Position3 PList2))
;	(checkcircle Pt3 1.0 "A51")
;	(setq Pt4 (polar Pt3 Ang (* LegLen Scale)))
;	(checkcircle Pt4 1.0 "A21")
	
	(setq 	Pt1 (trans Pt1 0 1)
			Pt2 (trans Pt2 0 1)
			Pt3 (trans Pt3 0 1)
;			Pt4 (trans Pt4 0 1)
	)
	(setq UAng (angle '(0 0) (getvar "UCSXDIR")))
	(setq Ang2 (- Ang2 UAng))
	(command "._dimstyle" "RE" theStyle)
	(command "dimrotated" (* 180 (/ Ang2 pi)) Pt1 Pt2 Pt3)
	(command "change" (entlast) "" "P" "LA" ItsLayer "")
	(entdel ObjName1)(entdel ObjName2)
 	
	(SD2056)
	(setq *error* nil)
	(princ)
)
;-----------------------------------------
(defun RegistryRead_1001()
	(setq Path1001 "HKEY_CURRENT_USER\\Software\\SpeedDraftLT\\SD_1001")
	(if (vl-registry-read Path1001 "LegLen" )
		(progn 	(set_tile "LegLen" (vl-registry-read Path1001 "LegLen"))
				(setq LegLen (atof (vl-registry-read Path1001 "LegLen")))
		)
		(setq LegLen 7.0)
	)
	(if (and (vl-registry-read Path1001 "Lay1" )(member (vl-registry-read Path1001 "Lay1") Laylist1))
		(progn 	(set_tile "Lay1" (itoa (vl-position (vl-registry-read Path1001 "Lay1") Laylist1)))
				(setq Lay1 (vl-registry-read Path1001 "Lay1"))
		)
		(progn 	(setq Lay1 (getvar "Clayer"))(set_tile "Lay1" (itoa (vl-position Lay1 Laylist1))))
	)
	(if (and (vl-registry-read Path1001 "LT1" )(member (vl-registry-read Path1001 "LT1") Laylist3))
		(progn 	(set_tile "LT1" (itoa (vl-position (vl-registry-read Path1001 "LT1") Laylist3)))
				(setq LT1 (vl-registry-read Path1001 "LT1"))
		)
		(progn 	(setq LT1 "ByLayer")(set_tile "LT1" "0"))
	)
	(if (and (vl-registry-read Path1001 "Col1" )(member (vl-registry-read Path1001 "Col1") Laylist2))
		(progn 	(set_tile "Col1" (itoa (vl-position (vl-registry-read Path1001 "Col1") Laylist2)))
				(setq Col1 (vl-registry-read Path1001 "Col1"))
		)
		(progn 	(setq Col1 "ByLayer")(set_tile "Col1" "0"))
	)
)
;----------------
(defun SD1028 ()
  (setq OldCmdEcho (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (command "undo" "be")
  (setq OldOsmode (getvar "OSMODE"))
  (setq OldLayer (getvar "CLAYER"))
  (setq OldLType (getvar "CeLType"))
  (setq OldCeLWeight (getvar "CeLWeight"))
  (setq OldColor (getvar "CeColor"))
  (setq OldOrtho (getvar "ORTHOMODE"))
  (setq OldDStyle  (getvar "DIMSTYLE"))
  (setq OldExpert (getvar "Expert"))
  (setvar "EXPERT" 0)
  (setq Path_Lang "HKEY_CURRENT_USER\\Software\\SpeedDraftLT")
;  (if (vl-registry-read Path_Lang "SD_Language" )
;  	(setq SD:Lang (vl-registry-read Path_Lang "SD_Language" ))
;  	(progn	(setq SD:Lang "J")
;  			(vl-registry-write Path_Lang "SD_Language" "J")
;  	)
;  )
  (princ)
)
;********************************
(defun SD2056 ()
  (setvar "OSMODE" OldOsmode)
  (command "undo" "end")
  (setvar "CLAYER" OldLayer)
  (setvar "CeLType" OldLType)
  (setvar "CeLWeight" OldCeLWeight)
  (setvar "CeColor" OldColor)
  (setvar "ORTHOMODE" OldOrtho)
  (setvar "Expert" OldExpert)
  (if (and (/= (getvar "DIMSTYLE") OldDStyle)(tblsearch "DIMSTYLE" OldDStyle))
  	(command "-dimstyle" "Restore" OldDStyle)
  )
  (princ "\n (C)OffshoreCad&Management")
  (setvar "CMDECHO" OldCmdEcho)
  (princ)
)

;********************************
(defun get_layer&ltype&color()
	(setq 	Lay (tblnext "LAYER" T)
			LT (tblnext "LTYPE" T)
			Laylist1 (list)
			Laylist2 (list "ByLayer" "Red" "Yellow" "Green" "Cyan" "Blue" "Magenta" "B/W")
			Laylist3 (list"ByLayer")
	)
	(While Lay
		(setq lay1 (list (cdr (assoc 2 Lay)))
			  lay2 (cdr (assoc 62 Lay))
			  lay3 (list (cdr (assoc 6 Lay)))
			  Laylist1 (append Laylist1 lay1)
			  Laylist3 (append Laylist3 lay3)
			  Lay (tblnext "LAYER")
		 )
	  	(if (> lay2 7)(setq  lay2 (list (itoa lay2)) Laylist2 (append Laylist2 lay2)))
	)
	(While LT
		(setq lay3 (list (cdr (assoc 2 LT)))
			  Laylist3 (append Laylist3 lay3)
			  LT (tblnext "LTYPE")
		 )
	)
	(setq 	Laylist1 (RemoveOverlap Laylist1)
			Laylist2 (RemoveOverlap Laylist2)
			Laylist3 (RemoveOverlap Laylist3))
)
;************************
(defun RemoveOverlap (	List2	/	List1	)
	(while List2
		(setq List1 (append List1 (list (car List2))))
		(setq List2 (vl-remove (car List2) List2))
	)
	List1
)
;;;---------Rotate----------------------------

(defun SD8446 ( PointA PointB Ang / XA YA XB YB PointC)

	(setq 	XA2(- (car PointA) (car PointB))
			YA2(- (cadr PointA) (cadr PointB))
	)
	(setq PointC (list (- (* XA2 (cos Ang))(* YA2 (sin Ang))) (+ (* XA2 (sin Ang))(* YA2 (cos Ang)))))
	(setq PointC (mapcar '+ PointC PointB))
	PointC
)
;****************************************************
(defun SD1862 (OldPt Ang / NewCs)
	(setq NewCs (SD8446 '(1 0) '(0 0) Ang))
	(setq NewPt (trans OldPt 0 NewCs))
	(setq NewPt (list (nth 2 NewPt)(nth 0 NewPt)))
	NewPt
)
;**********************
(defun SD3511 (g e)
	(cond
		((= (type e) 'ename) (cdr (assoc g (entget e))))
		((= (type e) 'list) (cdr (assoc g e)))
	)
)
;********************************
(defun *myerror* (msg)
	(setq *error* nil)
	(SD2056)
	(princ "\n Error in SpeedDraftLT")
	(princ)
)
	(princ "\n Command Name: JDIMS")
(princ)
Posted in AutoCAD 2015, AutoLISP, AutoLISP: Dimensions, AutoLISP: Modify, Dimensions | Leave a comment

AutoLISP: ATTWIPE Clear Selected Attribute Values

Here is one that lets you easily clear the selected attribute tag(s).

This is especially helpful for when you are editing titleblocks that have populated attributes or when you copy a block (symbol) that already has attribute values already populated.

Here’s how:

(After loading of coarse)

  • ATTWIPE [enter]
  • Select the individual attributes that you would like to clear…
  • hit [enter] when finished to end the routine

ATTWIPE1

 


;; ------------------------------------------------------------------------------
;; AttWipe - © 2005 by Chuck Chauvin
;; Posted at: http://www.theswamp.org/index.php?topic=4934.0;all
;; Clears (wipes) the value of a selected attribute
;; ------------------------------------------------------------------------------
(defun C:AttWipe (/ AttSel AttLoc)
  
  (defun *error* (msg)
    (princ "\nInvalid selection.")
    (princ)
  );_ end defun *error*

  (defun SelectIt (msg)
  (setq AttLoc (cadr (setq AttSel (entsel (strcat "\nPick " msg " to wipe: ")))))
    );_ end defun SelectIt

  (defun WipeIt (/)
    (command "-attedit" "y" "" "" "" AttLoc "" "v" "r" "" "n")
    );_ end defun WipeIt

  (setvar "cmdecho" 0)
  
  (SelectIt "attribute")
  (WipeIt)
  (while AttSel
    (SelectIt "next attribute")
    (if	(= (type AttSel) 'list)
      (WipeIt)
      (setq AttSel nil)
      ) ;_ end if
    ) ;_ end while
  (princ)
  );_ end defun AttWipe
;; ------------------------------------------------------------------------------
Posted in Attributes, AutoLISP, AutoLISP: Attributes, Blocks, Modifying | Leave a comment

AutoCAD 2015 Purge DGN Junk

That’s right, I called it “Junk”.

Recently we have been experiencing excessive bloating of files because somewhere in our project someone has either referenced in a drawing that was opened with Microstation or they have copied in something from a drawing that was used by Microstation.

Below is an example of a drawing that was almost 14 megabytes in size and needed to email it to someone out “in the field” but because of its file size, it was too large to email.
PURGE DGN 1

 

When you start the PURGE command in AutoCAD 2015, you now have the option to purge “Orphaned data.” AutoCAD apparently handles Microstation linestyles and text styles differently so the info that defines these objects becomes “orphaned” and can bloat drawings severely.

Check the box as shown below

PURGE DGN 2

 

If you have any of this purge-able data, the progress of the purge will be shown in the lower right of the AutoCAD screen (shown below)

PURGE DGN 3

 

To purge the “Orphaned” DGN junk from your drawings using the command line version of PURGE command in a script or macro, use the O (letter O) after issuing -PURGE from the command line.

PURGE DGN 4

 

Note: after purging what could be a lot of data from a drawing, it is a good idea to AUDIT your drawing. In the command line, enter AUDIT [enter] Y [enter]

For more info about how to purge unused DGN info from your drawings, check out these links:

Autodesk’s hotfix for AutoCAD 2013 & 2014: http://knowledge.autodesk.com/support/autocad/downloads/caas/downloads/content/autocad-C2-AE-dgn-hotfix.html

Kean’s explanations:

http://through-the-interface.typepad.com/through_the_interface/2012/12/purging-unwanted-dgn-linestyle-data-from-an-autocad-drawing-using-net.html

http://through-the-interface.typepad.com/through_the_interface/2013/07/autocad-dgn-hotfix-now-available.html

Posted in AutoCAD 2015, Manage, New in 2015 | Leave a comment