Draw line and a text with layer name and description for each layer (Layer Legend)


;;; Draw line and a text with layer name and description for each layer (Layer Legend)
;;; Created by HasanCAD
;;; Saved from: https://www.theswamp.org/index.php?topic=53481.0

(defun c:LLD () (c:LayerLegend))

(defun c:LayerLegend ( / df i ln p1 pt sp ) ;; Lee Mac 2011
(if
(and
(setq pt (getpoint "\nSpecify Point for Legend: "))
(setq ln (* 100 (getvar 'TEXTSIZE))) ;(getdist "\nSpecify Length of Lines: " pt))
(setq pt (trans pt 1 0))
(setq i -1)
(setq sp (* 1.5 (getvar 'TEXTSIZE)))
)
(while (setq df (tblnext "LAYER" (null df)))
(setq ent (vlax-ename->vla-object (tblobjname "LAYER" (cdr (assoc 2 df)))))
(setq dsc (vlax-get-property ent 'Description))
(setq nm (vlax-get-property ent 'name))
(entmakex (list
(cons 0 "LINE")
(cons 8 (cdr (assoc 2 df)))
(cons 6 "ByLayer")
(cons 62 256)
(cons 10
(setq p1 (polar pt (* 1.5 pi) (* (setq i (1+ i)) sp)))
)
(cons 11 (polar p1 0. ln))
(cons 370 -1)
)
)

(entmakex (list (cons 0 "TEXT") ;***
(cons 1 (strcat (cdr (assoc 2 df)) " : " dsc)) ;* (the string itself)
(cons 6 "BYLAYER") ; Linetype name
(cons 7 (getvar 'TEXTSTYLE)) ;* Text style name, defaults to STANDARD, not current
(cons 8 (cdr (assoc 2 df))) ; layer
(cons 10 p1) ;* First alignment point (in OCS)
(cons 11 p1) ;* Second alignment point (in OCS)
(cons 39 0.0) ; Thickness (optional; default = 0)
(cons 40 (getvar 'TEXTSIZE)) ;* Text height
(cons 41 1.0) ; Relative X scale factor, Width Factor, defaults to 1.0
(cons 62 256) ; color
(cons 71 0) ; Text generation flags
(cons 72 0) ; Horizontal text justification type
(cons 73 1) ; Vertical text justification type
(cons 210 (list 0.0 0.0 1.0))
(cons 370 -1)
))
) )
(princ)
)
(c:lld)

Advertisements

Rotate selected side of polyline to zero


;;; Rotate selected side of polyline to zero
;;; Created by phanaem
;;; Saved from: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/rotate-a-selected-side-of-a-polyline-to-zero-degrees-in-autolisp/td-p/7563715
;;; It is important where you make the selection.
;;; The nearest vertex is the base point of the rotation. The other vertex of the clicked segment is the reference point
(defun c:pz ( / e p a p1 p2)
(if
(setq e (entsel "\nSelect polyline segment to rotate to zero: "))
(progn
(setq p (cadr e)
e (car e)
a (vlax-curve-getparamatpoint e (vlax-curve-getclosestpointto e p))
p1 (vlax-curve-getpointatparam e (if (< (- a (fix a)) 0.5) (fix a) (1+ (fix a))))
p2 (vlax-curve-getpointatparam e (if (< (- a (fix a)) 0.5) (1+ (fix a)) (fix a)))
)
(command "_rotate" e "" "_non" p1 "_r" "_non" p1 "_non" p2 0.0)
)
)
(princ)
)
(c:pz)

Select Hatches with Equal, Smaller or Larger Area than specified by user


;; Hatch Select Criteria - HSC
;; Select Hatches with Equal, Smaller or Larger Area than specified by user
;; Created by ronjonp
;; Saved from https://www.theswamp.org/index.php?topic=53620.0

(defun c:hsc (/ a b fuzz e o s)
(sssetfirst nil nil)
(or *global* (setq *global* "Equal"))
;; Change this number to suit for equality check
(setq fuzz 0.1)
(if
(and
(setq e (car (entsel "\nPick a hatch to get area: ")))
(= 'real (type (setq a (vl-catch-all-apply 'vla-get-area (list (vlax-ename->vla-object e))))))
(not (initget "Equal Smaller Larger"))
(or (setq *global* (getkword (strcat "\nSpecify [Equal/Smaller/Larger] : ")))
*global*
)
(setq s (ssget '((0 . "hatch"))))
)
(progn
(foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
(setq o (eval (cdr (assoc *global* '(("Equal" . equal) ("Smaller" . ))))))
(if (= 'real
(type (setq b (vl-catch-all-apply 'vla-get-area (list (vlax-ename->vla-object x)))))
)
(if (null (cond ((= o equal) (o b a fuzz))
((and (o b a) (not (equal b a fuzz))))
)
)
(ssdel x s)
)
(ssdel x s)
)
)
(sssetfirst nil s)
)
)
(princ)
)
(vl-load-com)
(c:hsc)