Leaderboard

Where layer transparency is concerned, this may be of interest - https://www.theswamp.org/index.php?topic=52473.msg574001#msg574001

;;; blocks in group (defun c:big ( / gl ) (vl-load-com) (if (not (vl-consp (setq gl (lag)))) (alert "Computer says no : there are no groups") ;;; show all blocks in group (choose from group list) (sabig (cfl gl)) ) (princ) ) ;;; list all groups (setq rtn (lag)) (defun lag ( / gps lst) (setq gps (vla-get-groups (vla-get-activedocument (vlax-get-acad-object)))) (vlax-for g gps (setq lst (cons (vla-get-name g) lst))) (if (vl-consp lst) (acad_strlsort lst)) ) ; choose from list (cfl '("1""2""3")) (defun cfl (l / f p d r) (and (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ "cfl:dialog{label=\"Choose\";:list_box{key=\"lb\";width=40;}ok_cancel;}" p) (not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d) (progn (start_list "lb")(mapcar 'add_list l)(end_list)(action_tile "lb" "(setq r (nth (atoi $value) l))(done_dialog 1)") (action_tile "accept" "(setq r (get_tile \"lb\"))(done_dialog 1)")(action_tile "cancel" "(setq r nil)(done_dialog 0)") (start_dialog)(unload_dialog d)(vl-file-delete f))) (cond ((= r "") nil)(r r)(t nil))) ;;; display list (plus message) (defun dplm (l m / f p d w) (and (vl-consp l) (setq l (mapcar 'vl-princ-to-string l)) (setq w (+ 5 (apply 'max (mapcar 'strlen l)))) (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ (strcat "cfl:dialog{label=\"" m "\";:list_box {key=\"lb\";" "width="(itoa w)";}ok_only;}") p)(not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)(progn (start_list "lb") (mapcar 'add_list l)(end_list)(action_tile "accept" "(done_dialog)")(start_dialog)(unload_dialog d)(vl-file-delete f)))) ; multiple association (defun massoc ($i $l / a l)(while (setq a (assoc $i $l))(setq l (cons (cdr a) l) $l (cdr (member a $l))) l)) ;;; test if (vla) object is a block / get blockname / ename->vla-object (defun block-p (o) (and (setq o (e->o o)) (member (vla-get-objectname o) '("AcDbBlockReference" "AcDbBlockTableRecord")))) (defun block-n (o) (if (block-p o)(if (vlax-property-available-p o 'EffectiveName)(vla-Get-EffectiveName o)(vla-Get-Name o)))) (defun e->o (e) (cond ((= 'vla-object (type e)) e)((= 'ename (type e))(vlax-ename->vla-object e))(t nil))) ;;; show all blocks in group (defun sabig (gname / odic gdic grec el blist) (setq odic (namedobjdict)) (setq gdic (dictsearch odic "ACAD_GROUP")) (setq grec (dictsearch (cdar gdic) gname)) (setq el (massoc 340 grec)) (if (vl-consp el) (foreach x el (if (block-p x)(setq blist (cons (block-n (e->o x)) blist))))) (if (vl-consp blist) ;;; (dplm (acad_strlsort blist) (strcat "Blocks in group " gname)) (write-list blist) (alert (strcat "Computer says no : sorry no block in group " gname)) ) ) (defun write-list ( l / fn fp) (if (setq fp (open (setq fn (strcat (getvar "dwgprefix") "file1.txt")) "w")) (progn (foreach item l (write-line item fp)) (close fp) (gc) (gc) (startapp "notepad" fn) ) ) (princ) )

https://www.theswamp.org/index.php?topic=51248.msg563608#msg563608

PS: Someday you'll win one of those public tenders, and when that happens, I hope you'll come over here and have a coffee with one of us Good luck!

Hi @PGia I think this should meet your needs. I could say I wrote it from scratch just for you, but really, I also did it for myself. I had a good time revisiting old concepts. As I said, this is much easier to do with Map or Civil3D, creating topologies and manipulating them with the 'mnt*' functions. But writing this code has helped me prove that these tools can also be done in Lisp, with reasonably good results. The expressions are in my language. You'll have to translate them into yours. ;******************* G L A V C V S ******************* ;********************* F E C I T ********************* (defun c:spf>PGia (/ conj cj cjP ent n lstent en ex d pt i l lC lCs cE ltS ltV ltds s lSV actEtqs selR) (defun lSV (l / p r) (setq ltS (cons (list (setq s (vlax-ename->vla-object (car l))) (cadr l)) ltS) lCs (cons (list s (last l)) lCs)) (foreach x (reverse (cdr l)) (if p (if (not (member x ltds));ltds es la lista de los ya tocados (if (setq r (assoc p ltV)) (setq ltV (subst (list (car r) (+ (cadr r) (vla-get-area x))) r ltV) ltds (cons x ltds));ltV es una lista en que se asocia el identificador de las lineas contenedoras con la suma de la áreas de las contenidas (setq ltV (cons (list p (vla-get-area x)) ltV) ltds (cons x ltds)) ) ) ) (setq p x) ) ) (defun actEtqs (/ a b c e p pc l et tx) (foreach v (reverse ltS) (setq e (car v) p (cadr v) pc (last v)) (if (= (vla-get-layer e) "US") (setq l (cadr (assoc e lCs)) tx (vl-some '(lambda (x) (if (equal (cadr x) l) (vla-get-textstring (car x)))) ltS)) (setq tx nil) ) (if (/= (vla-get-layer e) "GEN") (vla-put-color p 6)) (vla-put-textstring e (strcat (if tx (strcat tx "-") "") (vla-get-textstring e) ":" (rtos (- (vla-get-area p) (if (setq a (assoc p ltV)) (cadr a) 0)) 2 2)) ) ) ) (defun selR (p / r s l lt en ex cj n o r4 f) (defun r2+ (p l r / i b) (vl-some '(lambda(g) (= 2 (setq r (if (foreach a (cons (last l) l) (if b (if (inters p (polar p g d) b (setq b a)) (setq i (not i))) (setq b a)) i) (+ r 1) r)))) '(0 1.5708 3.141592 4.71239) ) ) (if (setq cj (ssget "_F" (list p (list (car p) (+ (cadr p) (getvar "viewsize")))) (list '(0 . "LWP*") (cons 8 "PRMTR") '(-4 . "&=") '(70 . 1)) ) ) (while (setq e (ssname cj (setq n (if n (1+ n) 0)))) (if (r2+ p (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget e))) 0) (progn (setq l (cons (vlax-ename->vla-object e) l)) (if (ssmemb e cjP) (ssdel e cjP))) ) ) ) (if l (vl-sort l '(lambda (a b) (< (vla-get-Area a) (vla-get-Area b))))) ) (setq en (getvar "extmin") ex (getvar "extmax") n -1 d (max (- (car ex) (car en)) (- (cadr ex) (cadr en))) ) (vla-zoomExtents (vlax-get-acad-object)) (setq cjP (ssget "x" (list '(0 . "LWP*") (cons 8 "PRMTR") '(-4 . "&=") '(70 . 1)))) (if (setq conj (ssget "_X" '((0 . "TEXT") (8 . "GEN,US")))) (while (setq ent (ssname conj (setq n (1+ n)))) (setq lstent (entget ent) pt (cdr (assoc 10 lstent))) (if (setq l (selR pt)) (lSV (cons ent l)) (princ (strcat "\n*** Etiqueta " (cdr (assoc 1 lstent)) " huerfana"))) ) ) (if (> (sslength cjP) 0) (alert "ATENCION: Hay polilíneas sin asignar")) (alert (strcat "Numero de perímetros procesados: " (itoa (length ltS)))) (actEtqs) (princ) )

See attached code. 1. run the lisp in paper space. 2. the lisp prompt you to select a point on the block IN PAPER SPACE!! - click on the block. 3. click on the start point of the MLeader arrow - you are in paper space, no wories... 4. place the MLeader. 5. if you want to label another block go ahead. 6. to exit hit escape key or mouse right click. EDIT: the lisp works in model space as well. (defun c:MLeaderWBlname( / *error* temperr osnp tm tagname ptms ss ensel obj obj1 nam);ptps ptps1 (setq temperr *error*);store *error* (setq *error* trap1);re-assign *error* (setq osnp (getvar "OSMODE")) (setvar "OSMODE" 0) (setq tm (getvar "TILEMODE")) (princ "Select object in paper space,select start point of MLeader,exit with esc'") (while 1 (if (= tm 0);if in paper space (progn (getpoint) ;;get point in paper space on the target object (command "._MSPACE") (setq ptms (cadr (grread t)));;get the point where the cursor is on the target object in model space (setq ss (ssget ptms));;selction set of the object crossing the ptms point (setq obj(ssname ss 0)) (command "._PSPACE") );progn (progn ;in model space (setq ensel (entsel "\nSelect Block: ")) ;select the block object to copy (setq obj (car ensel)) ;set the block object to varaible );progn );if (setq obj1 (vlax-ename->vla-object obj)) (setq nam (vlax-get-property obj1 (if (vlax-property-available-p obj1 'effectivename) 'effectivename 'name ) ) ) (command "_mleader" "H" pause pause nam) );end while (setq *error* temperr) (princ) ) (defun trap1 (errmsg) (command "._PSPACE") (SETVAR "OSMODE" osnp) (princ) )

Nikon, you forgot to add open and closing brackets for v1 and v2... Like I said it should be : (atof v1) and (atof v2)...

Whereever in the code occurs v1 or v2, change them to (atof v1) and (atof v2)...

Very true. Glad to see you posting more Lee.

Presumably you're assuming an MLEADER as opposed to a LEADER? For a LEADER entity, an arrowhead size override is set within the extended entity data, e.g.: (defun c:myleader ( / p q s ) (if (and (setq p (getpoint "\n1st point: ")) (setq q (getpoint "\n2nd point: " p)) (setq s (getdist "\nSpecify arrowhead size: ")) ) (progn (regapp "ACAD") (entmake (list '(0 . "LEADER") '(100 . "AcDbEntity") '(100 . "AcDbLeader") (cons 10 (trans p 1 0)) (cons 10 (trans q 1 0)) (list -3 (list "ACAD" '(1000 . "DSTYLE") '(1002 . "{") '(1070 . 41) (cons 1040 s) '(1002 . "}") ) ) ) ) ) ) (princ) )

You could try this too: (defun c:foo (/ a d) (vlax-for l (vla-get-layers (setq d (vla-get-activedocument (vlax-get-acad-object)))) (cond ((= -1 (vlax-get l 'lock)) (vlax-put l 'lock 0) (setq a (cons l a)))) ) (vlax-for b (vla-get-blocks d) (if (= 0 (vlax-get b 'isxref) (vlax-get b 'islayout)) (vlax-for o b (vl-catch-all-apply 'vla-put-layer (list o "0")) (vl-catch-all-apply 'vla-put-color (list o 256)) ) ) ) (foreach l a (vlax-put l 'lock -1)) (vla-purgeall d) (vla-regen d acactiveviewport) (princ) )

As we say here in NL : garantie tot aan de deur I've updated RlxPaste in attempt to handle dynamic blocks a little different than the normal cut/copy stuff. At this time it only works (if it works at all) when you select 1 dynamic block to add. It checks if block is dynamic or not. If so , it reads all dymanic properties of this block (I nicked a couple of Grand Master Lee's routines but don't tell him ) Save the block (under a different name of course because you can't save a block with the same name as the dwg) Then it writes all properties to a text file in the same folder & same name as the block but with extenion dbd (dynamic block data). Theory is that after insert it reads this dbd file and puts all props back. If it works , oh happy day , if it doesn't this conversation never happend... RlxPaste.LSP

I never wrote this app with dynamic blocks in the back in my mind but I may have a look at this someday. Thing is , I have very few dynamic blocks myself. Probably can count them on one hand. Mainly because static block are easier to handle in lisp. (very difficult to teach old dragons new tricks haha)

If the inner text touches any segment of the lwpolyline, '(ssget "WP"...)' would not include the text in the selection set. Also, performing recursive 'ssget's could be too slow on large drawings.

Hi @p7q, You can use system variable nomutt. The default value is 0, you need to change it to 1. You can see from one of part from code (it will supress the default "Select objects:" from ssget): ........ (setq old_nomutt (getvar 'nomutt)) (setvar 'nomutt 1) (princ "Select all Text entities:") (setq ss (ssget '((0 . "*TEXT"))) ........ (setvar 'nomutt old_nomutt) (princ)

here's something to list all block names that live in a group ;;; blocks in group (defun c:big ( / gl ) (vl-load-com) (if (not (vl-consp (setq gl (lag)))) (alert "Computer says no : there are no groups") ;;; show all blocks in group (choose from group list) (sabig (cfl gl)) ) (princ) ) ;;; list all groups (setq rtn (lag)) (defun lag ( / gps lst) (setq gps (vla-get-groups (vla-get-activedocument (vlax-get-acad-object)))) (vlax-for g gps (setq lst (cons (vla-get-name g) lst))) (if (vl-consp lst) (acad_strlsort lst)) ) ; choose from list (cfl '("1""2""3")) (defun cfl (l / f p d r) (and (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ "cfl:dialog{label=\"Choose\";:list_box{key=\"lb\";width=40;}ok_cancel;}" p) (not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d) (progn (start_list "lb")(mapcar 'add_list l)(end_list)(action_tile "lb" "(setq r (nth (atoi $value) l))(done_dialog 1)") (action_tile "accept" "(setq r (get_tile \"lb\"))(done_dialog 1)")(action_tile "cancel" "(setq r nil)(done_dialog 0)") (start_dialog)(unload_dialog d)(vl-file-delete f))) (cond ((= r "") nil)(r r)(t nil))) ;;; display list (plus message) (defun dplm (l m / f p d w) (and (vl-consp l) (setq l (mapcar 'vl-princ-to-string l)) (setq w (+ 5 (apply 'max (mapcar 'strlen l)))) (setq p (open (setq f (vl-filename-mktemp ".dcl")) "w")) (princ (strcat "cfl:dialog{label=\"" m "\";:list_box {key=\"lb\";" "width="(itoa w)";}ok_only;}") p)(not (setq p (close p)))(< 0 (setq d (load_dialog f)))(new_dialog "cfl" d)(progn (start_list "lb") (mapcar 'add_list l)(end_list)(action_tile "accept" "(done_dialog)")(start_dialog)(unload_dialog d)(vl-file-delete f)))) ; multiple association (defun massoc ($i $l / a l)(while (setq a (assoc $i $l))(setq l (cons (cdr a) l) $l (cdr (member a $l))) l)) ;;; test if (vla) object is a block / get blockname / ename->vla-object (defun block-p (o) (and (setq o (e->o o)) (member (vla-get-objectname o) '("AcDbBlockReference" "AcDbBlockTableRecord")))) (defun block-n (o) (if (block-p o)(if (vlax-property-available-p o 'EffectiveName)(vla-Get-EffectiveName o)(vla-Get-Name o)))) (defun e->o (e) (cond ((= 'vla-object (type e)) e)((= 'ename (type e))(vlax-ename->vla-object e))(t nil))) ;;; show all blocks in group (defun sabig (gname / odic gdic grec el blist) (setq odic (namedobjdict)) (setq gdic (dictsearch odic "ACAD_GROUP")) (setq grec (dictsearch (cdar gdic) gname)) (setq el (massoc 340 grec)) (if (vl-consp el) (foreach x el (if (block-p x)(setq blist (cons (block-n (e->o x)) blist))))) (if (vl-consp blist) (dplm (acad_strlsort blist) (strcat "Blocks in group " gname)) (alert (strcat "Computer says no : sorry no block in group " gname)) ) )

Just a comment provided the layer exists, you can use a (cons 8 "Linework") in the entmake to make object on a certain layer.

This is not correct. Entities within the database are being modified, but the database is not being 'rearranged'. The reason that the loop does not terminate is because the equality & inequality operators work with strings & numerical data types, whereas the variables en & enlast are entity names (essentially pointers). As such, when comparing the pointers, the operators are not comparing the data to which they point, but the pointers themselves - this can be confirmed with the following simple test: _$ (setq e2 (entlast)) <Entity name: 2e2aabd68a0> _$ (setq e1 (car (entsel))) <Entity name: 2e2aabd68a0> Observe that variables e1 & e2 point to the same entity data, but have been created separately. When using the equality or inequality operators, the memory addresses of the pointers themselves are being compared, which are not equal: _$ (= e1 e2) nil _$ (/= e1 e2) T If we copy the pointer, the address will now be equal: _$ (setq e3 e1) <Entity name: 2e2aabd68a0> _$ (= e1 e3) T Instead, we should use the eq function to compare the data to which the pointers point: _$ (= e1 e2) nil _$ (eq e1 e2) T As such, the code could potentially be written: (defun c:tf ( / ed1 ed2 en enlast ) (setq enlast (entlast) en (entnext) ) (while (not (eq en enlast)) (setq ed1 (entget en) ed2 nil ) (if (= "LWPOLYLINE" (cdr (assoc 0 ed1))) (progn (foreach x ed1 (if (= 10 (car x)) (setq ed2 (append ed2 (list (list 10 (+ 100 (cadr x)) (+ 100 (caddr x)))))) (setq ed2 (append ed2 (list x))) ) ) (entmod ed2) ) ) (setq en (entnext en)) ) (princ) ) However, note that this will not operate on the last entity added to the database, and so to include it, we could write the code as: (defun c:tf ( / ed1 ed2 en ) (setq en (entnext)) (while en (setq ed1 (entget en) ed2 nil ) (if (= "LWPOLYLINE" (cdr (assoc 0 ed1))) (progn (foreach x ed1 (if (= 10 (car x)) (setq ed2 (append ed2 (list (list 10 (+ 100 (cadr x)) (+ 100 (caddr x)))))) (setq ed2 (append ed2 (list x))) ) ) (entmod ed2) ) ) (setq en (entnext en)) ) (princ) )

just a simplified example with GRREAD (only works for TEXT with integers and currently no undo built in) (defun RlxSel1 ( $e-type / done-selecting inp i p2 result e ent) (princ (strcat "\nEsc, enter, Rmouse to cancel, zoom with E(extend), Z(oom) or + / -\nSelect " $e-type)) (setq done-selecting nil) (while (not done-selecting) (setq inp (vl-catch-all-apply 'grread (list nil 4 2))) (if (vl-catch-all-error-p inp) (setq done-selecting t result nil) (cond ; if point selected ((= (car inp) 3) ; if point has object under it (if (setq ent (nentselp (cadr inp))) (setq e (car ent) typ (get_type e))) (cond ; if we have object and object is the right type we have a winner ((and e typ (eq $e-type typ)) (redraw e 3)(setq done-selecting t result e)) ; maybe its the parent ; this happens when type is dimension and you select dimensions text ((and (caddr ent) (setq ent (last (last ent)))(eq $e-type (get_type ent))) (redraw ent 3)(setq done-selecting t result ent)) ; sorry object is not the right stuf ((and e typ (not (eq $e-type typ))) (princ (strcat "\rYou selected the wrong type (" $e-type ")"))) ; else try crossing selection (t (if (and (setq i 0 p2 (getcorner (cadr inp) "\tOther corner : ")) (setq ss (ssget "c" (cadr inp) p2))) (while (setq e (ssname ss i)) (if (= (cdr (assoc 0 (entget e))) $e-type) (progn (redraw e 3) (setq result e done-selecting t))) (setq i (1+ i)))) );end t ); end cond ); end (= (car inp) 3) ; user pressed E of e ((member inp '((2 69)(2 101))) (command "zoom" "e")) ; user clicked R-mouse button, pressed enter or space (done selecting) ((or (equal (car inp) 25)(member inp '((2 13)(2 32)))) (setq done-selecting t result nil)) ; user pressed + ((equal inp '(2 43)) (command "zoom" "2x")) ; user pressed - ((equal inp '(2 45)) (command "zoom" ".5x")) ; user pressed z or Z ((member inp '((2 122)(2 90))) (command "'zoom" "")) ;;; enter undo routine here ;;; *********************** ) ) ) result ) ; 'kelvinated' (compressed) version of vt_splituptext ; (splitss (getvar 'dwgname)) -> ("06" "E" "001474" "S" "0011" ".DWG") ; (vl-remove-if-not 'distof (splitss "06E001474S0011.dwg")) -> ("06" "001474" "0011") ;;; (setq r (Splitss (cdr (assoc 1 (entget (car (entsel))))))) (defun splitss (s / a c p l d i) (if (and s (= (type s) 'str)(> (strlen s) 0)(setq i 1)(setq d ""))(progn (if (wcmatch (substr s i 1) "#")(setq p "num")(setq p "s")) (while (<= i (strlen s))(if (wcmatch (substr s i 1) "#")(setq c "num")(setq c "s"))(if (= c p)(setq d (strcat d (substr s i 1))) (progn (setq l (append l (list d)) p c d (substr s i 1))))(setq i (1+ i)))(if (and d (/= d ""))(setq l (append l (list d)))))) l) (defun isnum (n)(if (distof n) t nil)) (defun get_type ( %o ) (cond ((= (type %o) 'ENAME)(cdr (assoc 0 (entget %o)))) ((= (type %o) 'VLA-object)(cdr (assoc 0 (entget (vlax-vla-object->ename %o))))) (t nil) ) ) ;;; test 1 : increment with 1 (defun c:t1 ( / inc sel) (setq inc 1) (while (setq sel (RlxSel1 "TEXT")) (inc_ent sel)) (princ) ) (defun inc_ent (e / ent ent-type str-lst new-str-lst new-str done s len) (cond ((null e) (alert "Computer says no : nothing selected")) ((not (eq (type e) 'ename)) (alert (strcat "Computer says no : wrong type (" (vl-princ-to-string (type e)) ")"))) ((not (eq (setq ent-type (cdr (assoc 0 (setq ent (entget e))))) "TEXT")) (alert (strcat "Computer says no : selected object is not a text (" (vl-princ-to-string ent-type) ")"))) (t ;;; assuming last number must be incremented I reverse the string list and work from end to begin (setq done nil new-str-lst '() str-lst (reverse (Splitss (cdr (assoc 1 ent))))) (while (and (vl-consp str-lst) (not done) (setq s (car str-lst))) (setq str-lst (cdr str-lst)) (if (isnum s) (progn ;;; make sure "001" becomes "002" and not "2" (setq len (strlen s)) ;;; increment string with inc (setq s (itoa (+ inc (atoi s)))) ;;; put back leading zero's (while (< (strlen s) len) (setq s (strcat "0" s))) ;;; save to new string list (setq new-str-lst (cons s new-str-lst) done T) ) (setq new-str-lst (cons s new-str-lst)) );;; end if );;; end while (while (vl-consp str-lst) (setq new-str-lst (cons (car str-lst) new-str-lst) str-lst (cdr str-lst))) ;;; put string back together (if (vl-consp new-str-lst) (setq new-str (apply 'strcat new-str-lst))) ;;; update text object (setq ent (subst (cons 1 new-str) (assoc 1 ent) ent)) ;;; update ent (entmod ent)(entupd e) ) ) ) for undo to work built an undo (assoc) list with ent + original text string and when undoing get last ent in list , reset text and remove it from undo-list. Should look something like this : (setq undo-list (reverse (cdr (reverse undo-list)))) Unless you built this list with cons , then (setq undo-list (cdr undo-list)) will work too. I do have a far more advanced program (VT.lsp) for my increment jobs , posted it years ago , which I still use to this day. Added lots of options through the years but most of them are so company specific I don't think its useful to post the latest version (also it still doesn't like Mtext) because I have no use for Mtext for my line of work so every time I see one I blow it out of the water.

Yes, there isn't a perfect solution that I have found: (setq in the code will hint at the variable used but if the code is (setq a .... b ... c ...) it will only pick up a, not b, c atoms-family... unless the variable has been used previously, a global variable perhaps... which I think is the OPs intention to localise variables, though a new drawing where you only run the LISP in question should get most (except in auto-run LISPs). However in that any branches in the code - if statements - will only record the variables used in the particular branch selected, you'd need to run the code a few times to capture each possibility. Could try something like notepad++ where variables are highlighted, though that takes some discipline to record which variables are used.... good habits arn't bad thing

It is difficult to get variables declared in a lisp by just reading the file. Because it often happens that a variable is declared without having 'setq' in front of it. I think the safest way is to call 'atoms-family', execute the code in your file and then call 'atoms-family' again. The difference between the list returned by the first call and the second is the list you need.

A better place to save a value is using LDATA as some one else's code may reset the "Userxx", you can also do a UNDO mark so can go back many undo's in one step. (setq num (vlax-ldata-get "numinc" "num" )) (vlax-ldata-put "numinc" "num" x)

Good improvement! And one more thing... dmp.lsp

So that no one says that I throw stones and hide my hand, here is my proposal for improvement. (defun c:myDimAlign (/ x e p s d o pS os xD asr dt pr ar osmant) ;; A D * I N F I N I T V M A D * I N F I N I T V M A D * I N F I N I T V M ;; A D * I N F I N I T V M A D * I N F I N I T V M A D * I N F I N I T V M ;; ;;; ;; GGGG LL A VV VV CCCC VV VV SSSS ;;; ;; GG GG LL AA AA VV VV CC CC VV VV SS SS ;;; ;; GG LL AA AA VV VV CC VV VV SS ;;; ;; GG GGGG LL AA AA VV VV CC VV VV SSSS ;;; ;; GG GG LL AA AAA AA VV VV CC VV VV SS ;;; ;; GG GG LL LL AA AA V V CC CC V V SS SS ;;; ;; GGG LLLLLLLL AA AA VV CCCC VV SSSS ;;; ;; ;;; ;; A D * I N F I N I T V M A D * I N F I N I T V M A D * I N F I N I T V M ;; A D * I N F I N I T V M A D * I N F I N I T V M A D * I N F I N I T V M (defun os (/ d p i) (while (and (setq f (cdr (assoc 10 (setq x (cdr (member (setq p (assoc 10 x)) x)))))) (/= (max (distance (cdr p) pS) (distance f pS) (setq d (distance (setq i (cdr p)) f))) d) ) ) i ) (defun xD (c1 c2 / ed pt r of) (if (not dt) (setq dt (distance o (cadr s)) ar (asr (os) pS o)) ) (polar c2 (ar (angle c1 c2) (/ pi 2)) dt) ) (defun asr (p1 p2 p3 / a b) (if (> (abs (- (setq a (angle p1 p2)) (setq b (angle p2 p3)))) PI) (if (< a b) (if (> (+ a PI PI) b) - +) (if (> (- a PI PI) b) - +) ) (if (> a b) - +) ) ) (setq osmant (getvar 'OSMODE)) (setvar 'OSMODE 0) (if (and (setq e (car (setq s (entsel "\nSelect any LWpolyline...")))) (= (cdr (assoc 0 (setq x (entget e)))) "LWPOLYLINE") (setq o (getpoint (setq pS (cadr s)) "\nSide to act on...")) ) (foreach g (if (= (rem (cdr (assoc 70 x)) 2) 0) x (setq x (append x (list (assoc 10 x))))) (if (= (car g) 10) (if p (command "_DIMALIGNED" p (cdr g) (xD p (setq p (cdr g)))) (setq p (cdr g)) ) ) ) ) (if osmant (setvar 'OSMODE osmant)) (princ) )

There is something similar. AutoDimPL.lsp

Hey @Nikon, If I can give you some advice. I had the same situation about 2-3 years ago, and I've been thinking about how to do automatization in creating layouts. And, I figure it out the best way (for my purpose) is to make differents "dwg" with appropriate size of viewports with accompanying "dwt" files (where are you going to have a "block" section with the name of company, number of project, name of the project, etc.). The first one is to make a different sizes of desired viewports. This one from picture 1 is for the 297x420 cm paper size. The second one is to make a "dwt" files where are you going to put your viewport inside the layout. The picture 2 show how it looks layout for the paper size 297x420 cm. The third one is coding (this is the first time when I created something using autolisp, the first program). It will look like this (this is the part from the code): (while (< i len) (setq base nil) (setq xy nil) (setq obj (ssname ss i)) (setq data1 (entget (ssname ss i))) (setq blockname (cdr (assoc 2 data1))) (cond ((= blockname L1) (setq data2 (entget (entnext (cdr (assoc -1 data1))))) (setq data3 (entget (entnext (cdr (assoc -1 data2))))) (setq data4 (entget (entnext(cdr (assoc -1 data3))))) (setq base (cdr (assoc 11 data3))) (setq xy (cdr (assoc 1 data3))) (setq no (1+ i)) (setq data4 (subst (cons 1 (itoa no)) (assoc 1 data4) data4)) (entmod data4) (setq nno (strcat v1 "." v2 "." (itoa no))) (setq path (findfile ".\\Situacioni plan saobracajne signalizacije_297x420.dwt")) (command "layout" "t" path "1") (command "layout" "s" "1") (command "layout" "r" "" nno) (command "mspace" "ucs" "ob" obj "plan" "c" "zoom" "w" base xy "pspace") ) ................... I hope I gave you some idea, it is simillar as @BIGAL proposal. Best regards.

Me personally your going down the wrong path you have your title block in a layout at true size a A1 841x594 a A2 594x420, then you make your mview inside that title block, then set correct scale. The rectangs in model space are a scaled representative of the viewport size. Think about it. So again I need the size of your viewports in Each title block with the title block at true size. A A2 will be like 584x397 Did you look at the movie ?

Hi Attach a drawing with which your code works

I think a necessary improvement to all the codes proposed so far could be to get it to draw the dimensions on the side of the polyline desired by the user.

You can use SSGET to make a selection of dims then simply change their style. Either a entmod or VL method. Maybe as simple as this. (defun c:wow ( / ss obj) (setq ss (ssget (list (cons 0 "DIM*")))) (repeat (setq x (sslength ss)) (setq obj (vlax-ename->vla-object (ssname ss (setq x (- x 1))))) (vlax-put obj 'StyleName "Standard") ) (princ) ) (c:wow) OOPs thought I posted this yesterday.

Ok PM me I will talk via email. Yes you select scale and title block size, the title block is read from say a dwg containing all your layouts pre set up. Or can be made to match each title block that is inside the current dwg. As per code I posted all the size details are hard coded. You make say one or more rectang then just run step 2 and make the layouts. If you want different size then just run step one again. I need to see your title blocks in a dwg to work out settings. The other thing I did was a plottopdf.lsp that auto reads the title block name in a layout so matches correct plot settings again hard coded.

I deleted the drawing for you.

I have sent you a PM.

What I mean is that any rectangle, whatever its size, can be fitted into an A4 Layout without any problem, even if it does not keep the proportions of the standard formats. Simply adjust the A4 Layout Viewport to the proportions of the rectangle taken as a reference in the model space. A zoom in the model space of this viewport will achieve the final effect. But if you have to consider the size of the rectangle selected to use one Layout or another, everything is a little more complicated. I hope I have explained myself better now.

An important issue is the paper size of the target layout. Because, regardless of the size of the rectangle in model space, it can be adapted to the layout in paper space (with the relevant scaling considerations, of course). Forcing the code to select one paper size or another based on the size of the rectangle in model space will make the job a bit more complicated.

Where did you find this LISP?

As Bigal says, unless you already have code for this, writing a tool like that is well worth 1 coffee. Or 2. I'll try to write something when I have enough time. Unless someone already has something to do this and is generous enough to share it

I did give you an answer if you want rectangs start with the Viewport rectang the width and height in your layout title block. Then you draw the rectang to suit using the scale factor. Look at this front end. The match rotation part will cost you a coffee. (cond ((and (= sz "A0")(= orien "Landscape")) (setq ht 780.0 wid 1160.0 xpt 878.0 xwid 62.0 yht 32.0)) ((and (= sz "A1")(= orien "Landscape")) (setq Ht 541.0 wid 831.0 xpt 542.0 xwid 62.0 yht 32.0)) ((and (= sz "A1")(= orien "Portrait")) (setq Ht 774.0 wid 571.0 xpt 229.0 xwid 62.0 yht 32.0)) ((and (= sz "A2")(= orien "Landscape")) (setq ht 367.0 wid 584.0 xpt 295.5 xwid 62.0 yht 32.0)) ((and (= sz "A2")(= orien "Portrait")) (setq ht 554.0 wid 410.0 xpt 209.5 xwid 41.0 yht 23.0)) ((and (= sz "A3")(= orien "Landscape")) (setq ht 247.0 wid 400.0 xpt 200.0 xwid 41.0 yht 23.0)) ((and (= sz "A3")(= orien "Portrait")) ( close-drawrecs)) ((= sz "A4") (setq ht 180.0 wid 287.0)) ) Draw rectangs.mp4

Ztrain, I need help in general. I'm in the same PennFoster class you are. I've been trying to get the school to give me hands on help with this project but apparently they don't offer any of that. I know this is probably a long shot but is there a way I can email you or we can somehow get ahold of each other. I've only made it the lots part of the project and can't seem to figure it out. I've been working on this for a month, well I've been stuck for a month.

If I understand correctly, you want the 'LayOut' viewport to adapt proportionally to the selected rectangular polyline to display, by zooming, its content?

You do it in reverse to what you asked. you enter scale 1st. Then draw a rectang that matches the viewport in the layout scaled up or down to match scale. The other way is just pick a pt and use ZOOM C PT scale when in mspace use a dummy value for scale, then use zoom scXP the sc is simple for metres (setq sc (/ 1000 requiredscale) ) similar for mm a factor of 1000. The rotated rectangs answer will cost you a cup of coffee, as need to set up the rectang size to match say choices in paper size.

I have got it working now, I changed (if (> (length tls) 2) to (if (> (length tls) 1) and that seems to do the trick! Thanks for your help! Your routine will save me a lot of time.

Just a comment like @Lee Mac when doing ssget with filters "F" "CP" "WP" it is always a good idea to add the last point to the list again this has the effect of a closed group of points. (setq plent (entsel "\nPick rectang")) (if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent)))))) (setq co-ord (cons (last co-ord) co-ord))

Ok once you make a viewport you need to zoom to a point inside Mspace, you can set the scale of the viewport also in this 2 step process. (command "zoom" "C" (getpoint '\PIck center point ") 100) (command "zoom" (strcat (rtos scale 2 2) "XP) When you zoom C it sets the viewport centre point, using scaleXP ie 4XP resets the viewport scale but keeps the centre point. If you have rectangs in Model space then yes can make layouts that match. You need to start with something like this. I have made rectangs that follow a pline. The software finds them and makes layouts. Another version allows user placement, both methods can be used then layouts made. Happy to discuss how its done, are you metric or imperial ? There is some behind the scenes set up.

In any case, it could still be simplified a bit further. But leaving aside Maahee's choice of doing it with 'foreach'.... (defun c:myDimAlign (/ x e p f) (if (and (setq e (car (entsel "\nSelect any LWpolyline..."))) (= (cdr (assoc 0 (setq x (entget e)))) "LWPOLYLINE") ) (while (setq f (cdr (assoc 10 (setq x (cdr (member (setq p (assoc 10 x)) x)))))) (command "DIMALIGNED" (cdr p) f "@5<180") ) ) )

Fixed the X wall and also edited the prompt for the T so it's more explanatory. Like so: WALL-L X fixed.LSP

Thank you not only for your analysis of Penn-Foster and the AutoCAD coursework but also for your kind words. Good luck in your future endeavors.

I just finished the Penn Foster AutoCad course. Got a 96% overall score. Much thanks to ReMark and everyone else on this forum. It was pretty frustrating and would have been MUCH worse without the info I got here. I'm not sure that I would recommend Penn Foster to others. If I did, I would send the person straight here along with the recommendation. If you muscle through it you'll have a decent entry-level understanding of the program I guess. It's WAY more of a time and energy commitment than I expected, and a good chunk of that is not directly related to using the program. There are extensive "old-school" manual drafting chapters you start out with (you'll need to freshen up on geometry formulas) and it seems to take forever to even get access to downloading the program. After completing all that and accessing AutoCad 2017 you go through a long book with lessons, then jump into the 5 projects you finish with. First 3 projects are pretty brutal, then a couple much easier ones. The projects wouldn't be that bad, but the directions are very difficult to understand. It's all text based direction with not much visual reference at all. That's where 80% of your time goes, figuring out the instructions, not actually using the program. Anyways, if you NEED some type of cert for AutoCad and want to work on it on your own time with no in-person classes, Penn Foster works. Just be ready to be persistent though a pretty heavy dose of frustration.

DME55: No reply? I too remember AutoDesk Learning Assistant I just don't recall when it was stopped being released. Anyway, here are some options for learning AutoCAD while avoiding Penn-Foster. 1) The Mycadsite.com. Still the best free AutoCAD learning website in my opinion. The website's author has been producing tutorials since 1999. 2) The CAD Institute. If you are intent on doing an online certificate course then try this one. I would recommend signing up for these three courses to begin with: Fundamentals of AutoCAD, AutoCAD Tips & Tricks, and AutoCAD in 3D. There are three very specific courses available that cover AutoCAD for the architectural, electrical and mechanical disciplines. 3) Lynda CAD Training. They offer AutoCAD training and tutorials via videos created by AutoCAD professionals. 4) For self learners I'd recommend the Ascent Center for Technical Knowledge. They produce the manuals and DVDs used by Authorized AutoCAD Resellers to teach AutoCAD. One of the four above should work for you or anyone else seeking to learn AutoCAD.

Alternatively from here: ;; Project Point onto Line - Lee Mac ;; Projects pt onto the line defined by p1,p2 (defun LM:ProjectPointToLine ( pt p1 p2 / nm ) (setq nm (mapcar '- p2 p1) p1 (trans p1 0 nm) pt (trans pt 0 nm) ) (trans (list (car p1) (cadr p1) (caddr pt)) nm 0) ) Which could also be written: (defun LM:projectpointtoline ( pnt pt1 pt2 ) ( (lambda ( vec ) (trans (reverse (cons (caddr (trans pnt 0 vec)) (cdr (reverse (trans pt1 0 vec))))) vec 0)) (mapcar '- pt1 pt2) ) ) For your case: (setq xy1 '(1.0 1.0 0.0) xy2 '(2.0 3.0 0.0) xy3 '(1.5 1.6 0.0) xy4 (LM:projectpointtoline xy3 xy1 xy2) )