Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 07/02/2019 in all areas

  1. Bit dangerous better to copy the acad.ctb and edit a new custom one.
    1 point
  2. (defun c:lpr ( / e g p q ) (LM:grsnap:snapfunction) (while (not (progn (setvar 'errno 0) (setq e (entsel)) (cond ( (= 7 (getvar 'errno)) (prompt "\nMissed, try again.") ) ( (null e)) ( (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getclosestpointto e)) (prompt "\nInvalid object selected.") ) ( (setq osf (LM:grsnap:snapfunction)osm (getvar 'osmode)) (setq e (car e)) (while (= 5 (car (setq g (grread t 13 0)))) (redraw)(osf (cadr g) osm) (if (setq q (vlax-curve-getclosestpointto e (trans (cadr g) 1 0) t)) (grdraw (cadr g) (trans q 0 1) 1) ) ) (if (= 3 (car g)) (progn (entmake (list '(0 . "LINE") (cons 10 (setq p (trans (cadr g) 1 0))) (cons 11 (setq q (vlax-curve-getclosestpointto e (trans (cadr g) 1 0) t))) (cons 62 2) ) ) (entmakex (list (cons 0 "TEXT") (cons 10 (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p q))) (cons 11 (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p q))) (cons 1 (rtos (distance p q) 2 2)) (cons 50 (LM:readable(angle p q))) (cons 62 1)(cons 40 30)(cons 41 0.7)(cons 72 1)(cons 73 1) )) (princ "\nLine endpoints: ") (princ p) (princ " | ") (princ q) (princ "\nLength: ") (princ (distance p q)) ) t ) ) ) ) ) ) (redraw) (princ) ) (defun LM:readable ( a ) ( (lambda ( a ) (if (and (< (* pi 0.5) a) (<= a (* pi 1.5))) (LM:readable (+ a pi)) a ) ) (rem (+ a pi pi) (+ pi pi)) ) ) ;; Object Snap for grread: Snap Function - Lee Mac ;; Returns: [fun] A function requiring two arguments: ;; p - [lst] UCS Point to be snapped ;; o - [int] Object Snap bit code ;; The returned function returns either the snapped point (displaying an appropriate snap symbol) ;; or the supplied point if the snap failed for the given Object Snap bit code. (defun LM:grsnap:snapfunction ( ) (eval (list 'lambda '( p o / q ) (list 'if '(zerop (logand 16384 o)) (list 'if '(setq q (cdar (vl-sort (vl-remove-if 'null (mapcar (function (lambda ( a / b ) (if (and (= (car a) (logand (car a) o)) (setq b (osnap p (cdr a)))) (list (distance p b) b (car a)) ) ) ) '( (0001 . "_end") (0002 . "_mid") (0004 . "_cen") (0008 . "_nod") (0016 . "_qua") (0032 . "_int") (0064 . "_ins") (0128 . "_per") (0256 . "_tan") (0512 . "_nea") (2048 . "_app") (8192 . "_par") ) ) ) '(lambda ( a b ) (< (car a) (car b))) ) ) ) (list 'LM:grsnap:displaysnap '(car q) (list 'cdr (list 'assoc '(cadr q) (list 'quote (LM:grsnap:snapsymbols (atoi (cond ((getenv "AutoSnapSize")) ("5"))) ) ) ) ) (LM:OLE->ACI (if (= 1 (getvar 'cvport)) (atoi (cond ((getenv "Layout AutoSnap Color")) ("117761"))) (atoi (cond ((getenv "Model AutoSnap Color")) ("104193"))) ) ) ) ) ) '(cond ((car q)) (p)) ) ) ) ;; Object Snap for grread: Display Snap - Lee Mac ;; pnt - [lst] UCS point at which to display the symbol ;; lst - [lst] grvecs vector list ;; col - [int] ACI colour for displayed symbol ;; Returns nil (defun LM:grsnap:displaysnap ( pnt lst col / scl ) (setq scl (/ (getvar 'viewsize) (cadr (getvar 'screensize))) pnt (trans pnt 1 2) ) (grvecs (cons col lst) (list (list scl 0.0 0.0 (car pnt)) (list 0.0 scl 0.0 (cadr pnt)) (list 0.0 0.0 scl 0.0) '(0.0 0.0 0.0 1.0) ) ) ) ;; Object Snap for grread: Snap Symbols - Lee Mac ;; p - [int] Size of snap symbol in pixels ;; Returns: [lst] List of vector lists describing each Object Snap symbol (defun LM:grsnap:snapsymbols ( p / -p -q -r a c i l q r ) (setq -p (- p) q (1+ p) -q (- q) r (+ 2 p) -r (- r) i (/ pi 6.0) a 0.0 ) (repeat 12 (setq l (cons (list (* r (cos a)) (* r (sin a))) l) a (- a i) ) ) (setq c (apply 'append (mapcar 'list (cons (last l) l) l))) (list (list 1 (list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p) (list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q) ) (list 2 (list -r -q) (list 0 r) (list 0 r) (list r -q) (list -p -p) (list p -p) (list p -p) (list 0 p) (list 0 p) (list -p -p) (list -q -q) (list q -q) (list q -q) (list 0 q) (list 0 q) (list -q -q) ) (cons 4 c) (vl-list* 8 (list -r -r) (list r r) (list r -r) (list -r r) c) (list 16 (list p 0) (list 0 p) (list 0 p) (list -p 0) (list -p 0) (list 0 -p) (list 0 -p) (list p 0) (list q 0) (list 0 q) (list 0 q) (list -q 0) (list -q 0) (list 0 -q) (list 0 -q) (list q 0) (list r 0) (list 0 r) (list 0 r) (list -r 0) (list -r 0) (list 0 -r) (list 0 -r) (list r 0) ) (list 32 (list r r) (list -r -r) (list r q) (list -q -r) (list q r) (list -r -q) (list -r r) (list r -r) (list -q r) (list r -q) (list -r q) (list q -r) ) (list 64 '( 0 1) (list 0 p) (list 0 p) (list -p p) (list -p p) (list -p -1) (list -p -1) '( 0 -1) '( 0 -1) (list 0 -p) (list 0 -p) (list p -p) (list p -p) (list p 1) (list p 1) '( 0 1) '( 1 2) (list 1 q) (list 1 q) (list -q q) (list -q q) (list -q -2) (list -q -2) '(-1 -2) '(-1 -2) (list -1 -q) (list -1 -q) (list q -q) (list q -q) (list q 2) (list q 2) '( 1 2) ) (list 128 (list (1+ -p) 0) '(0 0) '(0 0) (list 0 (1+ -p)) (list (1+ -p) 1) '(1 1) '(1 1) (list 1 (1+ -p)) (list -p q) (list -p -p) (list -p -p) (list q -p) (list -q q) (list -q -q) (list -q -q) (list q -q) ) (vl-list* 256 (list -r r) (list r r) (list -r (1+ r)) (list r (1+ r)) c) (list 512 (list -p -p) (list p -p) (list -p p) (list p p) (list -q -q) (list q -q) (list q -q) (list -q q) (list -q q) (list q q) (list q q) (list -q -q) ) (list 2048 (list -p -p) (list p p) (list -p p) (list p -p) (list (+ p 05) -p) (list (+ p 06) -p) (list (+ p 05) -q) (list (+ p 06) -q) (list (+ p 09) -p) (list (+ p 10) -p) (list (+ p 09) -q) (list (+ p 10) -q) (list (+ p 13) -p) (list (+ p 14) -p) (list (+ p 13) -q) (list (+ p 14) -q) (list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p) (list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q) ) (list 8192 (list r 1) (list -r -q) (list r 0) (list -r -r) (list r q) (list -r -1) (list r r) (list -r 0)) ) ) ;; Object Snap for grread: Parse Point - Lee Mac ;; bpt - [lst] Basepoint for relative point input, e.g. @5,5 ;; str - [str] String representing point input ;; Returns: [lst] Point represented by the given string, else nil (defun LM:grsnap:parsepoint ( bpt str / str->lst lst ) (defun str->lst ( str / pos ) (if (setq pos (vl-string-position 44 str)) (cons (substr str 1 pos) (str->lst (substr str (+ pos 2)))) (list str) ) ) (if (wcmatch str "`@*") (setq str (substr str 2)) (setq bpt '(0.0 0.0 0.0)) ) (if (and (setq lst (mapcar 'distof (str->lst str))) (vl-every 'numberp lst) (< 1 (length lst) 4) ) (mapcar '+ bpt lst) ) ) ;; Object Snap for grread: Snap Mode - Lee Mac ;; str - [str] Object Snap modifier ;; Returns: [int] Object Snap bit code for the given modifier, else nil (defun LM:grsnap:snapmode ( str ) (vl-some (function (lambda ( x ) (if (wcmatch (car x) (strcat (strcase str t) "*")) (progn (princ (cadr x)) (caddr x) ) ) ) ) '( ("endpoint" " of " 00001) ("midpoint" " of " 00002) ("center" " of " 00004) ("node" " of " 00008) ("quadrant" " of " 00016) ("intersection" " of " 00032) ("insert" " of " 00064) ("perpendicular" " to " 00128) ("tangent" " to " 00256) ("nearest" " to " 00512) ("appint" " of " 02048) ("parallel" " to " 08192) ("none" "" 16384) ) ) ) ;; OLE -> ACI - Lee Mac ;; Args: c - [int] OLE Colour (defun LM:OLE->ACI ( c ) (apply 'LM:RGB->ACI (LM:OLE->RGB c)) ) ;; OLE -> RGB - Lee Mac ;; Args: c - [int] OLE Colour (defun LM:OLE->RGB ( c ) (mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(24 16 8)) ) ;; RGB -> ACI - Lee Mac ;; Args: r,g,b - [int] Red, Green, Blue values (defun LM:RGB->ACI ( r g b / c o ) (if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2)))) (progn (setq c (vl-catch-all-apply '(lambda ( ) (vla-setrgb o r g b) (vla-get-colorindex o)))) (vlax-release-object o) (if (vl-catch-all-error-p c) (prompt (strcat "\nError: " (vl-catch-all-error-message c))) c ) ) ) ) ;; Application Object - Lee Mac ;; Returns the VLA Application Object (defun LM:acapp nil (eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object))) (LM:acapp) ) ;;----------------------------------------------------------------------;;
    1 point
  3. Try the following: (defun c:lpr ( / e g p q ) (while (not (progn (setvar 'errno 0) (setq e (entsel)) (cond ( (= 7 (getvar 'errno)) (prompt "\nMissed, try again.") ) ( (null e)) ( (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getclosestpointto e)) (prompt "\nInvalid object selected.") ) ( (setq e (car e)) (while (= 5 (car (setq g (grread t 13 0)))) (redraw) (if (setq q (vlax-curve-getclosestpointto e (trans (cadr g) 1 0) t)) (grdraw (cadr g) (trans q 0 1) 1) ) ) (if (= 3 (car g)) (progn (entmake (list '(0 . "LINE") (cons 10 (setq p (trans (cadr g) 1 0))) (cons 11 (setq q (vlax-curve-getclosestpointto e (trans (cadr g) 1 0) t))) ) ) (princ "\nLine endpoints: ") (princ p) (princ " | ") (princ q) (princ "\nLength: ") (princ (distance p q)) ) t ) ) ) ) ) ) (redraw) (princ) )
    1 point
  4. You can't dock the command line above the scroll bar. If you want the command line and the scroll bar, drag the command line down below the scroll bar. Once you see the command line maximize across the screen, let go of your mouse button and the command line will dock below the scroll bar.
    1 point
  5. I pick stuff in model like text and its updated in a block 4 layouts away no jumping to layouts or anything so bottom line is yes it can be done. The block or blocks in my case multi lines must exist it uses a key to search say the riser number as you add riser 52 you look for the riser diagram block and find matching attribute 52 I guess if not then add. The program has various options you can run and changes different attributes within the block x&y, name, in, out etc. Its probably not a freebie. As what I have would need a full rewrite to suit, but happy to discuss.
    1 point
×
×
  • Create New...