Making selection set of LINES, LWPOLYLINES, ARCS, CIRCLES, SPLINES or ELLIPSES with specific length and angle


;;;Making selection set of LINES, LWPOLYLINES, ARCS, CIRCLES, SPLINES or ELLIPSES with specific length and angle
;;---------------=={ 3dwannab_Sel_Layer_Current.lsp }==-----------------;;
;; ;;
;; Selects LINES, LWPOLYLINES, ARCS, CIRCLES, SPLINES ;;
;; or ELLIPSES by exact length ;;
;;----------------------------------------------------------------------;;
;; Author: *Claypool, Jim ;;
;; Edit: 3dwannab
;; Edit: Igal Averbuh 2019 ;;
;;----------------------------------------------------------------------;;
;; Version 1.0 - 11-10-2002 - *Claypool, Jim ;;
;; Version 1.1 - 09-03-2017 - 3dwannab (First Edit) ;;
;; Version 1.11 - 09-03-2017 - 3dwannab (added SPLINE,ELLIPSE)
;; Version 1.12 - 13-06-2019 - Igal Aberbuh (added option for exact length) ;;
;;----------------------------------------------------------------------;;
;; Original: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/delete-lines-shorter-than-specify-length/m-p/909791#M135449
;;----------------------------------------------------------------------;;

(defun c:QS( / ss1 ss2 cnt selcnt ename e len)

(vl-load-com)
(setq ss2 (ssadd))

(setq maxsize (getdist "\nEnter Exact length of LINES, LWPOLYLINES, ARCS, CIRCLES, SPLINES or ELLIPSES: "))
(setq ss1 (ssget "X" '((0 . "LINE,ARC,LWPOLYLINE,CIRCLE,SPLINE,ELLIPSE"))))

(setq cnt 0 selcnt 0)
(if ss1
(progn
(repeat (sslength ss1)
(setq

ename (ssname ss1 cnt)

e (vlax-ename->vla-object ename)
len
(vlax-curve-getdistAtParam e (vlax-curve-getEndParam e))

)
(if
(equal len
maxsize)
(progn

(ssadd ename ss2)

(setq selcnt (1+ selcnt))

)

)
(setq cnt (1+ cnt))
)
(princ (strcat "\nNew Selection " (itoa selcnt) " of " (itoa cnt) " selected LINES, LWPOLYLINES, ARCS, CIRCLES, SPLINES or ELLIPSES")) (princ)
(sssetfirst nil ss2)
)
)
)

;; End of FN ;;

(c:qs)

Select similar closed objects according to area (filter by area)


;;; Select similar closed objects according to area
;;; Created by Lee Mac
;;; Saved from: https://www.cadtutor.net/forum/topic/61315-duplicate-polygons-total/?tab=comments#comment-506422

(defun c:ssa ( / cnt def ent ftr idx lst ss1 ss2 tar tol )

(setq tol 1e-6) ;; Tolerance for area comparison

(while (setq def (tblnext "layer" (not def)))
(if (or ( 0 (cdr (assoc 62 def)))
)
(setq lst (cons (cons 8 (cdr (assoc 2 def))) lst))
)
)
(cond
( (null
(setq ss1
(ssget "_X"
(setq ftr
(append
'( (0 . "CIRCLE,ELLIPSE,*POLYLINE,SPLINE")
(-4 . "<NOT")
(-4 . "")
(-4 . "NOT>")
(-4 . "<NOT")
(-4 . "<AND")
(0 . "ELLIPSE")
(-4 . "<OR")
(-4 . "") (41 . 0.0)
(-4 . "") (42 . 6.283185307179586)
(-4 . "OR>")
(-4 . "AND>")
(-4 . "NOT>")
)
(if lst (append '((-4 . "<NOT") (-4 . "") (-4 . "NOT>"))))
(if (= 1 (getvar 'cvport))
(list (cons 410 (getvar 'ctab)))
'((410 . "Model"))
)
)
)
)
)
)
(princ "\nNo valid objects found in the current layout.")
)
( (setq ss2 (ssget "_+.:E:S" ftr))
(setq tar (vlax-curve-getarea (ssname ss2 0)))
(repeat (setq idx (sslength ss1))
(setq ent (ssname ss1 (setq idx (1- idx))))
(or (equal tar (vlax-curve-getarea ent) tol)
(ssdel ent ss1)
)
)
(if (< 0 (setq cnt (1- (sslength ss1))))
(progn
(sssetfirst nil ss1)
(princ (strcat "\n" (itoa cnt) " other object" (if (= 1 cnt) "" "s") " with the same area found in the current space."))
)
(princ "\nNo other objects with the same area found in the current layout.")
)
)
)
(princ)
)
(vl-load-com) (princ)
(c:ssa)

Delete Lines or Polylines by length


;;; Delete Lines or Polylines by length
;;; Based on Tharwat routine (modified by Igal Averbuh 2019)
;;; Saved from: https://www.cadtutor.net/forum/topic/41282-erase-specified-length-of-lines-in-by-scriptlisp/

(defun c:fbl (/ dist ss i sn l)
(if (and (setq dist (getdist "\nEnter Line or Polyline Length numerical or by 2 points on screen: "))
(setq ss (ssget "_:L" '((0 . "LINE,LWPOLYLINE"))))
)
(repeat (setq i (sslength ss))
(setq sn (ssname ss (setq i (1- i))))
(setq l
(vlax-curve-getdistatpoint
sn
(vlax-curve-getEndPoint sn)
)
)
(if (equal l dist 1e-4)
(entdel sn)
)
)
)
(princ)
)
(c:fbl)

Attribute Global Change for Value, Height, Angle, Style,Layer, Color, Width, or (Increment or Multiply Numeric values)


;*******************************ATGL.LSP****************************************
; Written By : Peter Jamtgaard offerd for public use NO WARRANTY
; Purpose : Attribute Global Change for Value, Height, Angle, Style,
; : Layer, Color, Width, or (Increment or Multiply Numeric values)
; Instructions: Enter Block Name, Value, and Tag Specifications.
; : Then Select BLOCKS (Note: NOT Attributes) then select
; : the Characteristic you wish to change.
;*******************************************************************************
(defun C:AGC ()
(setq Y 0 B 0 C 0 KIND 0)
(setq CMDDIA (getvar "CMDDIA"))
(if (= CMDDIA 0)
(progn
(princ "\nDialog Box Disabled by CMDDIA. ")
(princ "\nBlock Name Specification? : ")
(setq BNS (strcase (getstring)))
(if (= BNS "")(setq BNS "*"))
(princ "Attribute Value Specification? : ")
(setq AVS (strcase (getstring)))
(if (= AVS "")(setq AVS "*"))
(princ "Attribute Tag Specification? : ")
(setq ATS (strcase (getstring)))
(if (= ATS "")(setq ATS "*"))
(atgl2)
)
(progn
(setq BNS "*" AVS "*" ATS "*")
(setq id (load_dialog "atgl.dcl"))
(new_dialog "atgl" id)
(set_tile "string1" "")
(set_tile "string2" "")
(set_tile "title" "Block Name Specification? ")
(set_tile "string" BNS)
(action_tile "string" "(setq BNS (strcase (get_tile \"string\")))")
(if (= 1 (start_dialog))
(progn
(done_dialog)
(new_dialog "atgl" id)
(set_tile "string1" "")
(set_tile "string2" (strcat "Block Name Specification? " BNS))
(set_tile "title" "Attribute Value Specification? ")
(set_tile "string" AVS)
(action_tile "string" "(setq AVS (strcase (get_tile \"string\")))")
(if (= 1 (start_dialog))
(progn
(done_dialog)
(new_dialog "atgl" id)
(set_tile "string1" "")
(set_tile "string1" (strcat "Block Name Specification? " BNS))
(set_tile "string2" (strcat "Attribute Value Specification? " AVS))
(set_tile "title" "Attribute Tag Specification ? ")
(set_tile "string" ATS)
(action_tile "string" "(setq ATS (strcase (get_tile \"string\")))")
(if (= 1 (start_dialog))
(progn
(done_dialog)
(atgl2)
)
(done_dialog)
)
)
(done_dialog)
)
)
(done_dialog)
)
)
)
(prin1)
)
(defun ATGL2 ()
(princ "Select Blocks with Attributes: ")
(SELSET)
(if (= CMDDIA 0)
(progn
(princ "Angle/Color/Height/Increment/Layer/Multiply/Rotate/Style/Value/Width/chT: ")
(setq SD 1)
(setq TRAIT1 (strcase (getstring)) KIND 0)
(setq TRAIT1 (substr TRAIT1 1 1))
(if (= TRAIT1 "V")
(setq STRING3 (getstring T "\nNew Value: ") ASO 1 KIND 0)
(if (= TRAIT1 "T")
(progn
(setq OS (getstring T "\nOld String: ") ASO 1 KIND 0 SD 1
NS (getstring T "\nNew String: "))
)
(if (= TRAIT1 "H")
(setq NUMBER1 (getreal "\nNew Height: ") ASO 40 KIND 1)
(if (= TRAIT1 "A")
(setq NUMBER1 (/ (* (getreal "\nNew Angle: ") PI) 180) ASO 50 KIND 1)
(if (= TRAIT1 "S")
(setq STRING3 (getstring "\nNew Style: ") ASO 7)
(if (= TRAIT1 "L")
(setq STRING3 (getstring T "\nNew Layer: ") ASO 8)
(if (= TRAIT1 "C")
(setq NUMBER1 (getint "\nNew Color: ") KIND 1 ASO 62)
(if (= TRAIT1 "W")
(setq NUMBER1 (getreal "\nNew Width: ") KIND 1 ASO 41)
(if (= TRAIT1 "I")
(progn
(setq INCR (getreal "\nIncrement: "))
(setq DEC (getint "\nDecimal Point Number [0]: ") KIND 0 ASO 1)
(if (= DEC nil)(setq DEC 0))
)
(if ( = TRAIT1 "M")
(progn
(setq MULTP (getreal "\nMultiplier: "))
(setq DEC (getint "\nDecimal Point Number [0]: ") KIND 0 ASO 1)
(if (= DEC nil)(setq DEC 0))
)
(if (= TRAIT1 "R")
(setq NUMBER1 (/ (* (getreal "\nNew Angle: ") PI) 180) ASO 50 KIND 1)
(setq B 1)
)
)
)
)
)
)
)
)
)
)
)
(PRINC "*")
(atgl3)
)
(ddatgl2)
)
)
(defun ATGL3 ()
(setq B 0 C 0 X 0)
(while (= B 0)
(setq ENT (ssname SSET C))
(if (= ENT nil)(setq B 1)
(progn
(setq ED (entget ENT))
(setq TYPE1 (cdr (assoc 0 ED)))
(if (= TYPE1 "INSERT")
(progn
(setq BLOCK (cdr (assoc 2 ED)))
(if (wcmatch BLOCK BNS)
(progn
(setq X 0)
(setq NENT (entnext ENT))
(setq NED (entget NENT))
(setq NTYPE (cdr (assoc 0 NED)))
(if (= NTYPE "ATTRIB")
(progn
(setq flag 0)
(while (= X 0)
(if (= NENT nil)(setq X 1)
(progn
(setq FLAG1 0)
(setq FLAG2 0)
(setq NAM (cdr (assoc 1 NED)))
(if (= TRAIT1 "I")(setq STRING3 (rtos (+ INCR (atof NAM)) 2 DEC)))
(if (= TRAIT1 "M")(setq STRING3 (rtos (* MULTP (atof NAM)) 2 DEC)))
(SETQ TAG (cdr (assoc 2 NED)))
(if (= ATS "*")(setq FLAG1 1))
(if (WCMATCH TAG ATS)(setq FLAG1 1))
(if (= TAG ATS)(setq FLAG1 1))
(if (= AVS "*")(setq FLAG2 1))
(if (WCMATCH NAM AVS)(setq FLAG2 1))
(if (= NAM AVS)(setq FLAG2 1))
(if (= FLAG2 1)
(if (= FLAG1 1)
(if (= KIND 0)
(if (/= TRAIT1 "T")
(setq NED (subst (cons ASO STRING3)(assoc ASO NED) NED))
(atglswap OS NS)
)
(progn
(if (= ASO 62)
(progn
(if (or (> NUMBER1 256)( DEC 8)(setq DEC 8))
(if ( DEC 8)(setq DEC 8))
(if (< DEC 0)(setq DEC 0))
(atgl3)
)
(defun ATGLVALUE ()
(setq STRING3 "")
(new_dialog "atglvalue" id)
(set_tile "V" STRING3)
(action_tile "V" "(setq STRING3 (get_tile \"V\"))")
(start_dialog)
(atgl3)
)
(defun ATGLWIDTH ()
(setq NUMBER1 1.0)
(new_dialog "atglwidth" id)
(set_tile "W" "1.0")
(action_tile "W" "(setq NUMBER1 (atof $value))")
(start_dialog)
(done_dialog)
(atgl3)
)
(defun ATGLSTYLE ()
(atglstyle2)
(setq STYLIST (SORTLIST STYLIST))
(ddatgls)
(atglstyle3)
(setq STRING3 STYLE)
(atgl3)
)
(defun SELSET ()
(setq SSET nil)
(while (= SSET nil)
(setq SSET (ssget))
(if (= SSET nil)
(princ "\nNull selection set please try again:")
)
)
)
(defun ATGLSTYLE2 ()
(setq B 0 C 0)
(while (= B 0)
(if (= C 0)
(progn
(setq STYLEL (tblnext "style" 1))
(setq STYLIST (list (cdr (assoc 2 STYLEL))))
(setq C 1)
)
(progn
(setq STYLEL (tblnext "style"))
(if (= STYLEL nil)(setq B 1)
(progn
(setq STYLIST (append STYLIST (list (cdr (assoc 2 STYLEL)))))
)
)
)
)
)
)
(defun ATGLCHT ()
(setq CMDDIA (getvar "CMDDIA"))
(if (= CMDDIA 0)
(progn
(princ "\nDialog Box Disabled by CMDDIA. ")
(setq OS (getstring T "\nEnter Old String: "))
(setq NS (getstring T "\nEnter New String: "))
(swapstring)
)
(progn
(setq OS "" NS "")
(new_dialog "atglcht" id)
(set_tile "oldstring" "")
(set_tile "title" "Old String: ")
(set_tile "string" "")
(action_tile "string" "(setq OS (get_tile \"string\"))")
(if (= 1 (start_dialog))
(progn
(done_dialog)
(new_dialog "atglcht" id)
(set_tile "oldstring" (strcat "Old String: " OS))
(set_tile "title" "New String: ")
(set_tile "string" "")
(action_tile "string" "(setq NS (get_tile \"string\"))")
(if (= 1 (start_dialog))
(progn
(done_dialog)
(atgl3)
)
(done_dialog)
)
)
(done_dialog)
)
)
)
(prin1)
)

(defun DDATGLS ()
(setq STYLENUM 0)
(setq id (load_dialog "atgl.dcl"))
(new_dialog "atglstyle" id)
(start_list "styles")
(mapcar 'add_list stylist)
(end_list)
(set_tile "styles" "0")
(action_tile "styles" "(setq STYLENUM (atoi $value))")
(start_dialog)
(done_dialog)
(setq STYLE (nth STYLENUM STYLIST))
)
(defun SORTLIST (LIST1)
(setq B 0)
(while (= B 0)
(setq C 1 D 0 E 0)
(setq PART1 (nth 0 LIST1))
(repeat (- (length LIST1) 1)
(setq PART2 (nth C LIST1))
(if ( C2 LNL)(setq B2 1))
)
(setq NED (subst (cons 1 NLN)(assoc 1 NED) NED))
(entmod NED)
(entmod ED)
)
)
)

;******************************************************************************
(defun SELSET ()
(setq SSET nil)
(while (= SSET nil)
(setq SSET (ssget))
(if (= SSET nil)
(princ "\nNull selection set please try again:")
)
)
(princ)
)
(prin1)
(c:agc)

****************************************** ATGL.DCL ****************************

atgl : dialog {
label="Enter Attribute Filters";
initial_focus = string;
: text_part {
key = "string1";
width = 30;
}
: spacer {
}
: text_part {
key = "string2";
width = 30;
}
: row {
: text_part {
key = "title";
width = 30;
}
: edit_box {
allow_accept = true;
key = "string";
width = 15;
}
}
ok_cancel;
}
atgl2 : dialog {
label="Select Characteristic";
initial_focus = string;
: boxed_row {
: column {
: button {
allow_accept = true;
key = "A";
label = "&Angle ";
mnemonic = "A";
width = 10;
}
: button {
allow_accept = true;
key = "C";
label = "&Color ";
mnemonic = "C";
width = 10;
}
}
: column {
: button {
allow_accept = true;
key = "H";
label = "&Height ";
mnemonic = "H";
width = 10;
}
: button {
allow_accept = true;
key = "I";
label = "&Increment";
mnemonic = "I";
width = 10;
}
}
: column {
: button {
allow_accept = true;
key = "L";
label = "&Layer ";
mnemonic = "L";
width = 10;
}
: button {
allow_accept = true;
key = "M";
label = "&Multiply ";
mnemonic = "M";
width = 10;
}
}
: column {
: button {
allow_accept = true;
key = "S";
label = "&Style ";
mnemonic = "S";
width = 10;
}
: button {
allow_accept = true;
key = "V";
label = "&Value ";
mnemonic = "V";
width = 10;
}
}
: column {
: button {
allow_accept = true;
key = "W";
label = "&Width ";
mnemonic = "W";
width = 10;
}
: button {
allow_accept = true;
key = "T";
label = "ch&T ";
mnemonic = "T";
width = 10;
}
}
}
ok_cancel;
}
atglangle : dialog {
label = "Enter New Attribute Angle";
initial_focus = "A";
: edit_box {
allow_accept = true;
key = "A";
label = "Angle";
width = 12;
}
ok_cancel;
}
atglcolor : dialog {
label = "Enter New Attribute Color";
initial_focus = "C";
: edit_box {
allow_accept = true;
key = "C";
label = "Color";
width = 12;
}
ok_only;
}
atglheight : dialog {
label = "Enter New Attribute Height";
initial_focus = "H";
: edit_box {
allow_accept = true;
key = "H";
label = "Height";
width = 12;
}
ok_only;
}
atglinc : dialog {
label = "Enter New Numeric Increment";
initial_focus = "string2";
: row {
: text_part {
key = "title1";
width = 15;
}
: text_part {
key = "string1";
width = 12;
}
}
: row {
: text_part {
key = "title2";
width = 15;
}
: edit_box {
allow_accept = true;
key = "string2";
width = 12;
}
}
ok_cancel;
}
atgllayer : dialog {
label="Set Attribute Layer";
: list_box {
key = "layers";
height = 5;
width = 40;
allow_accept = true;
}
ok_only;
}
atglmult : dialog {
label = "Enter New Numeric Increment";
initial_focus = "string2";
: row {
: text_part {
key = "title1";
width = 15;
}
: text_part {
key = "string1";
width = 12;
}
}
: row {
: text_part {
key = "title2";
width = 15;
}
: edit_box {
allow_accept = true;
key = "string2";
width = 12;
}
}
ok_cancel;
}
atglstyle : dialog {
label="Set Attribute Style";
: list_box {
key = "styles";
height = 5;
width = 38;
allow_accept = true;
}
ok_only;
}
atglcht : dialog {
label="Replace Text Strings";
initial_focus = string;
: text_part {
key = "oldstring";
width = 11;
}
: row {
: text_part {
key = "title";
width = 11;
}
: edit_box {
key = "string";
width = 15;
allow_accept = true;
}
}
ok_cancel;
}
atglvalue : dialog {
label = "Enter New Attribute Value";
initial_focus = "V";
: edit_box {
is_tab_stop = true;
allow_accept = true;
key = "V";
label = "Value";
width = 30;
}
ok_only;
}
atglwidth : dialog {
label = "Enter New Attribute Width";
initial_focus = "W";
: edit_box {
allow_accept = true;
key = "W";
label = "Width";
width = 30;
}
ok_only;
}

Delete All Layers with LB* mask (mask can be changed)


;;; Delete Layers with LB* mask
;;; Henrique Moreira da Silva modified routine
;;; http://forums.autodesk.com/t5/user/viewprofilepage/user-id/75977

(defun c:lay ( / hms:LayerList* cla ech lay* laylst)

(defun hms:LayerList* (path / LayName TblName TblNameList)
(while (setq TblName (tblnext "Layer" (null TblName)))
(if (wcmatch (setq LayName (strcase (cdr (assoc 2 TblName)))) (strcase path))
(setq TblNameList (cons LayName TblNameList))
)
)
(acad_strlsort TblNameList)
);; hmsLayerList*

(if (and (setq lay* "LB*") ;here to put layers mask
(not (wcmatch (strcase lay*) "0*,DEFPOINTS*"))
(setq LayList (hms:LayerList* lay*))
)
(progn
(setq ech (getvar 'CMDECHO))
(setvar 'CMDECHO 0)
(command "_.undo" "G")
(command "_.-layer" "_U" lay* "_T" lay* "")
(setq cla (strcase (getvar 'CLAYER)))
(if (member cla LayList)
(command "_.-layer" "_U" "0" "_T" "0" "_S" "0" "")
)
(foreach l LayList
(command "_.-laydel" "_N" l "" "_Y")
)
(command "_.undo" "E")
(setvar 'CMDECHO ech)
)
(prompt "\n Layer Name not valid, or no matching layers... ")
)
(princ)
)

Change Height of All Attributes in All Blocks in “one shot”


;;;Argument: hgt= height of attribute
;;;Example: ;;;Argument: hgt= height of attribute
;;;Example: (AttHgt 2.5)
;;;Ken Alexander 8/30/02.
(defun AttHgt (hgt / doc selset att catt)
(vl-load-com)
(setq doc (vla-get-activedocument (vla-get-application (vlax-get-acad-object))))
(vla-startundomark doc)
(if (ssget "x" (list (cons 0 "INSERT")))
(setq selset (vla-get-ActiveSelectionSet doc))
)
(if selset
(progn
(vlax-for item selset
(cond
((= (vl-catch-all-apply 'vla-get-HasAttributes (list item))
:vlax-true
)
(setq att (vlax-variant-value (vla-getattributes item))
catt (vlax-variant-value (vla-getconstantattributes item))
)
(if (safearray-value att)
(mapcar '(lambda (x)
(vla-put-height x hgt))
(vlax-safearray->list att)
)
)
(if (safearray-value catt)
(mapcar '(lambda (x) (vla-put-height x hgt))
(vlax-safearray->list catt)
)
)
(vla-update item)
)
)
)
)
)
(vla-endundomark doc)
(princ)
)
;;;Ken Alexander 8/30/02.
(defun AttHgt (hgt / doc selset att catt)
(vl-load-com)
(setq doc (vla-get-activedocument (vla-get-application (vlax-get-acad-object))))
(vla-startundomark doc)
(if (ssget "x" (list (cons 0 "INSERT")))
(setq selset (vla-get-ActiveSelectionSet doc))
)
(if selset
(progn
(vlax-for item selset
(cond
((= (vl-catch-all-apply 'vla-get-HasAttributes (list item))
:vlax-true
)
(setq att (vlax-variant-value (vla-getattributes item))
catt (vlax-variant-value (vla-getconstantattributes item))
)
(if (safearray-value att)
(mapcar '(lambda (x)
(vla-put-height x hgt))
(vlax-safearray->list att)
)
)
(if (safearray-value catt)
(mapcar '(lambda (x) (vla-put-height x hgt))
(vlax-safearray->list catt)
)
)
(vla-update item)
)
)
)
)
)
(vla-endundomark doc)
(princ)
)

Filter close polylines by internal area range


;;; Filter close polylines by internal area range
;;; Author unknown

(defun c:fba ( / *Error* CNT ENT AREA MINAREA MAXAREA ss StartPoint EndPoint)
(vl-load-com)
(command "cmdecho" 0)
(defun *Error* (Msg)
(cond
((or (not Msg)
(member Msg '("console break"
"Function cancelled"
"quit / exit abort"
)
) ;close member
) ;close or
) ;close condition, no message to display
((princ (strcat "\nError: " Msg))) ;else display message
) ;close cond
(princ)
) ;close defun *Error*

(setq MINAREA (getdist "\nEnter minimum area value: "))
(setq MAXAREA (getdist "\nEnter maximum area value: "))

(if (ssget "I")
(setq SS (ssget "I" '((0 . "LWPOLYLINE"))))
(setq SS (ssget '((0 . "LWPOLYLINE"))))
) ;end if

(setq CNT 0)
(repeat (sslength SS)

(setq ENT (ssname SS CNT)
AREA (vla-get-area (vlax-ename->vla-object ENT))
StartPoint (vlax-curve-getStartPoint (vlax-ename->vla-object ENT))
EndPoint (vlax-curve-getEndPoint (vlax-ename->vla-object ENT))
) ;end setq

(if (or (and (= MAXAREA AREA) (equal StartPoint EndPoint))
(equal MINAREA AREA 0.00001)
(equal MAXAREA AREA 0.00001)
) ;end or
(setq CNT (1+ CNT))
(ssdel ENT SS)
) ;end if
) ;end repeat
(command "cmdecho" 1)
(if (> (sslength SS) 0)
(progn
(princ (strcat "Number of objects selected = "(itoa (sslength SS))))
(sssetfirst nil SS)
) ;progn
(princ "No objects met the criteria ") ;else
) ;end if
(*Error* nil)
(princ)
) ;end defun

Filter lines and polylines by length range or by fixed length


;;; Filter lines and polylines by length range or by fixed length
;;; Author unknown

(defun c:FBL ( / *Error* cnt ent fixlen len stpt enpt maxlen minlen mode ss OPT)
(vl-load-com)
(defun *Error* (Msg)
(cond
((or (not Msg)
(member Msg '("console break"
"Function cancelled"
"quit / exit abort"
)
) ;close member
) ;close or
) ;close condition, no message to display
((princ (strcat "\nError: " Msg))) ;else display message
) ;close cond
(princ)
) ;close defun *Error*

(initget 1 "L P B")
(setq OPT (getkword "\nWant to Select [Line/Polyline/Both]: "))

(initget 1 "R F ")
(setq MODE
(getkword "\nSelect lines within (R)ange or (F)ixed length : "))
;(if (or (= MODE "") (= MODE "F"))
;(setq MODE "F")
;) ;end if

(if (= MODE "F")
(setq FIXLEN (getdist "\nEnter fixed line length: "))
(progn
(setq MINLEN (getdist "\nEnter minimum length: "))
(setq MAXLEN (getdist "\nEnter maximum length: "))
) ;end progn else
) ;end if

(if (ssget "I")
(progn
(cond ((= OPT "L")
(setq SS (ssget "I" '((0 . "LINE"))))
) ;end cond L

((= OPT "P")
(setq SS (ssget "I" '((0 . "*POLYLINE"))))
) ;end cond P
((= OPT "B")
(setq SS (ssget "I" '((0 . "LINE,*POLYLINE"))))
) ;end cond B
) ;end conditions
)
(progn
(cond ((= OPT "L")
(setq SS (ssget '((0 . "LINE"))))
) ;end cond L

((= OPT "P")
(setq SS (ssget '((0 . "*POLYLINE"))))
) ;end cond P
((= OPT "B")
(setq SS (ssget '((0 . "LINE,*POLYLINE"))))
) ;end cond B
) ;end conditions
)
) ;end if
(setq CNT 0)
(repeat (sslength SS)

(setq ENT (ssname SS CNT)
;STPT (cdr (assoc 10 (entget ENT)))
;ENPT (cdr (assoc 11 (entget ENT)))
LEN (vla-get-length (vlax-ename->vla-object ENT))
) ;end setq

(cond ((= MODE "F")
(if (equal FIXLEN LEN 0.00001)
(setq CNT (1+ CNT)) ;then next
(ssdel ENT SS) ;else delete
) ;end if
) ;end cond F

((= MODE "R")
(if (or (and (= MAXLEN LEN))
(equal MINLEN LEN 0.00001)
(equal MAXLEN LEN 0.00001)
) ;end or
(setq CNT (1+ CNT))
(ssdel ENT SS)
) ;end if
) ;end cond R
) ;end conditions
) ;end repeat

(if (> (sslength SS) 0)
(progn
(princ (strcat "Number of objects selected = "(itoa (sslength SS))))
(sssetfirst nil SS)
) ;progn
(princ "No objects met the criteria ") ;else
) ;end if
(*Error* nil)
(princ)
) ;end defun

Create Viewport in Paper Space from specified 2D orthogonal view in Model Space and rotate created view parallel to rotated MS object with selecting rotation angle by 2 points on object within viewport.


;;; Create Viewport in Paper Space from specified 2D orthogonal view in Model Space
;;; and rotate created view parallel to rotated MS object with selecting rotation angle by 2 points on MS object.
;;; Created by Igal Averbuh 2019
;;; Based on modified version of Clark Johnson and SWARAJ BARAL routines

(defun c:rv (/ sset DPL DPLS vprt a1 a2)

;;; Rotate View in paperspace
;;; Written By Clark Johnson - Toromont Energy Systems, Inc.
;;; Concept from Cadalyst Tips & Tools Weekly - Sept. 15, 2008 - http://www.cadalyst.com
;;; by SWARAJ BARAL
;;;
;;; Modified by Igal Averbuh 2019 (added option to set the view angle specified by two points)

(vl-load-com)
(setvar "cmdecho" 0)
(command "pspace");;move to paperspace
(terpri)
(setq sset(ssget "L" '((0 . "viewport"))));;Select viewport
;;;
(setq DPL (vlax-ename->vla-object (ssname sset 0)));;Get viewport name
(setq DPLS (vlax-get-property DPL "DisplayLocked"));;Get Locked Status for Viewport
(vla-put-DisplayLocked DPL :vlax-true);; LOCK Viewport
;;;
(setq vprt(cdr(assoc 69 (entget(ssname sset 0)))))
(command "._mspace")
(princ "\nSelect view rotation angle by 2 points on screen")

(setq P1 (getpoint "\nEnter First Point :"))
(setq P2 (getpoint P1 "\nSecond Point :"))
(vla-put-DisplayLocked DPL :vlax-false);; UNLOCK Viewport

;(setq a1 (getangle "\nEnter or Select rotation angle..."));;Get Rotation Angle
;(setq a2 (* a1 57.29578))

(command "mspace");;move to modelspace
(command "cvport" vprt);;Get selected viewport

(command "DVIEW" "" "TW" (/ (* -180 (angle P1 P2)) pi) "")

(command "pspace");;Return to paperspace
;;;
(vla-put-DisplayLocked DPL :vlax-true)
;(vla-put-DisplayLocked DPL DPLS);;; Restore Locked Status for Viewport
;;;
(setvar "cmdecho" 1)
(princ)
)

(defun c:ivp (/ vpl vplyes l0 ln layers cp cl cs ofs vpc1 vpc2 vpxd vpyd vpc svpc ssvp ssvp1 sf lpno vpno ssnum vpent nvpc1 nvpc2 nvpc1x nvpc1y nvpc2x nvpc2y)

(setvar "cmdecho" 0) ; Turn off command line echoing
(setvar "tilemode" 0)
(setq cp (getvar "ctab")) ; Store current tab name
(setq cl (getvar "clayer")) ; Store current layer name
(setq cs (getvar "osmode")) ; Store current osnap mode
(setq vpl "Viewport") ; ==>> Assume using Viewport layer for viewport frames, change code value here if needed <> Set viewport border offset from actual detail, change code value here if needed <<==
(setvar "osmode" 16416) ; Turn osnap off
(if (/= cp "Model") ; Must be started from a layout tab to establish destination, quit quietly if on Model tab
(progn
(princ "\n") ; Clean up command line
(setq vplyes 0) ; Assume viewport doesn't exist
(setq l0 (tblnext "LAYER" 1)) ; Get past 0 layer in layer list
(while (setq layers (tblnext "LAYER")) ; Loop through layer list collection
(setq ln (cdr (assoc 2 layers))) ; Extract layer name from list
(if (= (strcase ln) (strcase vpl)) (setq vplyes 1)) ; Check if viewport layer exists
)
(if (= vplyes 0) (command "layer" "NEW" vpl "COLOR" "1" vpl "")) ; Make viewport layer and assign color to red if doesn't exist
(setvar "clayer" vpl) ; Change to viewport layer
(command "layer" "ON" (strcat "0," vpl) "UNLOCK" (strcat "0," vpl) "") ; Turn on and unlock viewport and 0 layer
(command "zoom" "e") ; View entire layout tab
(setvar "ctab" "Model") ; Activate Model tab
; (command "zoom" "e") ; View entire Model Space area
(setq vpc1 (getpoint "\nSpecify first corner of model space window area: ")) ; Just pick rough area including all relavent details, will fine-tune border area later in Paper Space
(if vpc1 ; Quietly quit if no point specified
(progn
(setq vpc2 (getcorner vpc1 "\nSpecify opposite corner of model space window area: ")) ; Window rectangle can be designated in any direction
(if vpc2 ; Quietly quit if no point specified
(progn
(princ "\n") ; Clean up command line
(setvar "ctab" cp) ; Return to layout tab program was started from
(command "pspace") ; Switch to Paper Space of layout tab
(setq svpc (getpoint "\nSpecify destination of paper space viewport center: ")) ; Can't change layout tabs manually here
(if svpc ; Quietly quit if no point specified
(progn
(setq sf (getreal "\nViewport zoom scale factor : ")) ; Default to full-scale if no value is inputted
(if (= sf nil) (setq sf 1.0) (setq sf (abs sf))) ; Make sure scale factor is positive number
(setq vpxd (* sf (abs (- (car vpc2) (car vpc1))))) ; Determine horizontal length of selected window
(setq vpyd (* sf (abs (- (cadr vpc2) (cadr vpc1))))) ; Determine vertical height of selected window
(setq vpc (list (/ (+ (car vpc1) (car vpc2)) 2.0) (/ (+ (cadr vpc1) (cadr vpc2)) 2.0) 0.0)) ; Determine center point of selected model window
(command "mview" (list (- (car svpc) (/ vpxd 2.0)) (- (cadr svpc) (/ vpyd 2.0))) (strcat "@" (rtos vpxd) "," (rtos vpyd))) ; Create Paper Space viewport
(setq ssvp (ssget "L")) ; Start selection set with last viewport frame
(setq ssvp1 (ssget "L")) ; Another copy of viewport frame selection set
(command "mspace") ; Open viewport window to Model Space
(command "ucsicon" "ON") ; Turn on UCS icon for viewport
(command "ucs" "WORLD") ; Reset UCS to WCS
(command "zoom" "C" vpc (rtos vpyd)) ; Center view of viewport window using determined point
(command "zoom" "SCALE" (strcat (rtos sf) "XP")) ; Set zoom scale of viewport window
(command "vports" "LOCK" "ON" ssvp "") ; Lock scale and position of model in viewport
(command "pspace") ; Close viewport window
(command "zoom" (list (- (car svpc) (/ vpxd 2.0)) (- (cadr svpc) (/ vpyd 2.0))) (strcat "@" (rtos vpxd) "," (rtos vpyd))) ; Zoom in on just created viewport extremes
(command "zoom" "0.95X") ; Back zoom off slightly to see edges clearly
(setq lpno 2) ; Loop counter for making separate viewports
(setq vpno 1) ; Create single viewport
(if (>= vpno 2) ; Proceed to copy current viewport if 2 or more separate viewports desired
(progn
(while (<= lpno vpno) ; Check if viewport loop counter less than number of viewports desired
(command "copy" ssvp "" "0,0" "@0,0") ; Make copy of new viewport laying exactly on top of first viewport
(setq lpno (1+ lpno)) ; Increment viewport loop counter
(ssadd (entlast) ssvp1) ; Add viewport copy to selection set
)
)
)
(setq ssnum 0) ; Loop counter for fine-tuning separate viewports
(while (= vpno 2) ; Check for multiple viewports
(setq clt (strcat " #" (rtos (+ ssnum 1) 2 0))) ; Make command prompt string if using multiple viewports
(setq clt "") ; Make command prompt string if using single viewport
)
(initget 128) ; Enable string responses from point prompt
(setvar "osmode" 32)
(setq nvpc1 (getpoint (strcat "\nSpecify first corner of viewport" clt " window area or [Center point of circle]: "))) ; Pick actual part corner, program will apply offset
(if nvpc1 ; Will repeat asking for first corner if none specified
(progn
(if (= 'STR (type nvpc1)) ; Check if string was inputted instead of corner point
(progn
(if (= "C" (strcase (substr nvpc1 1 1))) ; Check if asking for circular viewport area
(progn
(setq nvpc1 (getpoint (strcat "\nSpecify center of viewport" clt " window area: "))) ; Pick center of separate circular viewport window
(if nvpc1 ; Will return to asking for first corner if center not specified
(progn
(setvar "osmode" 0) ; Turn osnap off
(princ (strcat "\nSpecify radius of viewport" clt " window area: ")) ; Make command prompt for circle viewport
(command "circle" nvpc1 pause) ; Make circle to clip existing viewport
(setvar "osmode" 2559) ; Turn osnap on
(setq ssvp (ssget "L")) ; Select last circle
(command "vpclip" vpent ssvp) ; Clip existing viewport to circle
(setq ssnum (1+ ssnum)) ; Increment fine-tuned viewport loop counter
)
)
)
)
)
(progn
(setq nvpc2 (getcorner nvpc1 (strcat "\nSpecify opposite corner of viewport" clt " window area: "))) ; Window rectangle can be designated in any direction, pick actual part corner, program will apply offset
(if nvpc2 ; Will repeat asking for first corner if none specified
(progn
(setq nvpc1x (car nvpc1)) ; Find X portion of first corner
(setq nvpc1y (cadr nvpc1)) ; Find Y portion of first corner
(setq nvpc2x (car nvpc2)) ; Find X portion of second corner
(setq nvpc2y (cadr nvpc2)) ; Find Y portion of second corner
(if (> nvpc2x nvpc1x) ; Determine horizontal direction of viewport window rectangle
(progn
(setq nvpc2x (+ nvpc2x ofs)) ; Add horizontal offset to right of specified left-to-right window rectangle
(setq nvpc1x (- nvpc1x ofs)) ; Add horizontal offset to left of specified left-to-right window rectangle
)
(progn
(setq nvpc2x (- nvpc2x ofs)) ; Add horizontal offset to left of specified right-to-left window rectangle
(setq nvpc1x (+ nvpc1x ofs)) ; Add horizontal offset to right of specified right-to-left window rectangle
)
)
(if (> nvpc2y nvpc1y) ; Determine vertical direction of viewport window rectangle
(progn
(setq nvpc2y (+ nvpc2y ofs)) ; Add vertical offset to top of specified lower-to-upper window rectangle
(setq nvpc1y (- nvpc1y ofs)) ; Add vertical offset to bottom of specified lower-to-upper window rectangle
)
(progn
(setq nvpc2y (- nvpc2y ofs)) ; Add vertical offset to bottom of specified upper-to-lower window rectangle
(setq nvpc1y (+ nvpc1y ofs)) ; Add vertical offset to top of specified upper-to-lower window rectangle
)
)
(setvar "osmode" 0) ; Turn osnap off
(command "rectang" (list nvpc1x nvpc1y) (list nvpc2x nvpc2y)) ; Make rectangle with offset to clip existing viewport
(setvar "osmode" 2559) ; Turn osnap on
(setq ssvp (ssget "L")) ; Select last rectange
(command "vpclip" vpent ssvp) ; Clip existing viewport to rectangle
(command "vpclip" ssvp "d" ) ; Convert Polygonal Vport to Rectangular

(setq ssnum (1+ ssnum)) ; Increment fine-tuned viewport loop counter
)
)
)
)
)
)
)
)
)
)
)
)
)

(c:rv) ;Rotate View in current viewport

)
(princ "\nThis command must be started from a layout sheet!") ; Need to start on a layout tab so program knows where to create the new viewports
)
(setvar "ctab" cp) ; Reset to stored tab name
(setvar "clayer" cl) ; Reset to stored layer name
(setvar "osmode" cs) ; Reset to stored osnap mode
(setvar "cmdecho" 1) ; Turn on command line echoing
(princ) ; Clean up and exit
)

Rotate View in paperspace (view rotation angle by 2 points on screen)


;;; Rotate View in paperspace
;;; Written By Clark Johnson - Toromont Energy Systems, Inc.
;;; Concept from Cadalyst Tips & Tools Weekly - Sept. 15, 2008 - http://www.cadalyst.com
;;; by SWARAJ BARAL
;;;
;;; Modified by Igal Averbuh 2019 (added option to set the view angle specified by two points)

(defun c:rv (/ sset DPL DPLS vprt a1 a2)
(vl-load-com)
(setvar "cmdecho" 0)
(command "pspace");;move to paperspace
(terpri)
(princ "\nSelect Viewport to rotate...")
(setq sset(ssget ":s" '((0 . "viewport"))));;Select viewport
;;;
(setq DPL (vlax-ename->vla-object (ssname sset 0)));;Get viewport name
(setq DPLS (vlax-get-property DPL "DisplayLocked"));;Get Locked Status for Viewport
(vla-put-DisplayLocked DPL :vlax-true);; LOCK Viewport
;;;
(setq vprt(cdr(assoc 69 (entget(ssname sset 0)))))
(command "._mspace")
(princ "\Select view rotation angle by 2 points on screen")

(setq P1 (getpoint "\nEnter First Point :"))
(setq P2 (getpoint P1 "\nSecond Point :"))
(vla-put-DisplayLocked DPL :vlax-false);; UNLOCK Viewport

;(setq a1 (getangle "\nEnter or Select rotation angle..."));;Get Rotation Angle
;(setq a2 (* a1 57.29578))

(command "mspace");;move to modelspace
(command "cvport" vprt);;Get selected viewport

(command "DVIEW" "" "TW" (/ (* -180 (angle P1 P2)) pi) "")

(command "pspace");;Return to paperspace
;;;
(vla-put-DisplayLocked DPL :vlax-true)
;(vla-put-DisplayLocked DPL DPLS);;; Restore Locked Status for Viewport
;;;
(setvar "cmdecho" 1)
(princ)
)