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

https://www.lee-mac.com/unformatstring.html

Only one DIMALIGNED call is required, e.g.: (defun c:mydimalign ( / e p x ) (if (and (setq e (car (entsel))) (= "LWPOLYLINE" (cdr (assoc 0 (setq x (entget e))))) ) (foreach g x (cond ( (/= 10 (car g))) ( p (command "_.dimaligned" p (setq p (cdr g)) "@5<180")) ( (setq p (cdr g))) ) ) ) (princ) )

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.

Maybe this will help you (defun c:trocapa (/ conj ent n) (setq n -1) (princ "\nSelect TEXTs/MTEXTs...") (if (setq conj (ssget '((0 . "*TEXT")))) (while (setq ent (ssname conj (setq n (1+ n)))) (entmod (append (entget ent) (list (cons 8 "MyLayer") (cons 62 256)))) ) ) (princ) )

Even though the codes should work but would draw them vertically.

To account for such a case, you can append the first vertex to the DXF data list, e.g.: (defun c:mydimalign ( / e p x ) (if (and (setq e (car (entsel))) (= "LWPOLYLINE" (cdr (assoc 0 (setq x (entget e))))) ) (foreach g (if (= 1 (logand 1 (cdr (assoc 70 x)))) (append x (list (assoc 10 x))) x) (cond ( (/= 10 (car g))) ( p (command "_.dimaligned" p (setq p (cdr g)) "@5<180")) ( (setq p (cdr g))) ) ) ) (princ) )

EXCEPT, if there are more objects in the drawing, of course.

(defun c:crViewportFromPL ( / pts minPt maxPt width height lst) (setq pline (car (entsel "\nSelect a polyline: "))) (if (and pline (= (cdr (assoc 0 (entget pline))) "LWPOLYLINE")) (progn (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget pline)))) (setq minPt (list (apply 'min (mapcar 'car pts)) (apply 'min (mapcar 'cadr pts)))) (setq maxPt (list (apply 'max (mapcar 'car pts)) (apply 'max (mapcar 'cadr pts)))) (setq width (- (car maxPt) (car minPt))) ) (setq height (- (cadr maxPt) (cadr minPt))) ) (if (setq lst (layoutlist)) (progn (setvar 'CTAB (car lst)) (vl-cmdf "_zoom" "_w" minPt maxPt) ) ) ;;; (command "_.-VPORTS" "_M" "1" "1" "0" "0" width height) )

Maybe use (setq pline (car (entsel "\nPick pline "))) (setq pts (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget pline))))) (command "Mview" (car pts)(caddr pts)) (command "Mspace") (command "Zoom" "E")

If you want to change the name of the destination layer you just have to change the 'MyLayer' code to the name you want.

Replace it with this (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget pline))))

But... Better thought, it's basically the same thing.

@Lee Mac Or another variation of your idea (defun c:myDimAlign (/ x e g p) (if (and (setq e (car (entsel "\nSelect any LWpolyline..."))) (= (cdr (assoc 0 (setq x (entget e)))) "LWPOLYLINE") ) (foreach g x (if (= (car g) 10) (if p (command "DIMALIGNED" p (setq p (cdr g)) "@5<180") (setq p (cdr g)) ) ) ) ) )

Here is my attempt with foreach function based on the request of the OP. (defun c:DimPly ( / sel 1st ) ;;--------------------------------------------;; ;; Author : Tharwat Al Choufi ;; ;; ;; ;; www.AutolispPrograms.WordPress.com ;; ;;--------------------------------------------;; (and (princ "\nSelect LWpolyline to dimension : ") (or (setq sel (ssget "_+.:S:E" '((0 . "LWPOLYLINE")))) (alert "Invalid object.! Try again") ) (foreach itm (entget (ssname sel 0)) (and (= (car itm) 10) (or (and 1st (or (command "_.DIMALIGNED" "_non" 1st "_non" (setq 1st (trans (cdr itm) 0 1)) "@0.35<180") t)) (setq 1st (trans (cdr itm) 0 1)) ) ) ) ) (princ) )

Yeah you are right, I should have retrieved the coordinates excluding the GC 10. Codes updated.

No. I've already tried those options. However, when I checked your message and looked at the code again, I thought I saw that you forgot to remove the 10 code in the first 'foreach'. Maybe that's what it is and when drawing the 'dimensions' it does so at the coordinate x=10. For this reason I didn't see the command display anything on the screen. I'll check it when I get home

Nothing special in the codes, but if you are not using the English version then you may need to add the prefixed symbols _. to command name.

By the way, Tharwat: I can't get your code to work Could it be my problem?

I see there is consensus on the idea of getting each pair of points by executing 'foreach' twice In my case, I'm going to insist on getting it in just 1, reducing the executed code as much as possible (or at least that's what I think) and preserving the original code as much as possible. I suppose there will be differences of opinion on this (defun c:myDimAlign (/ bm pline sublist pt1 pt2) (if (and (setq pline (car (entsel "\nSelect any LWpolyline..."))) (= (cdr (assoc 0 (setq bm (entget pline)))) "LWPOLYLINE"); Check if the entity type is LWPOLYLINE ) (progn (command "_.chprop" pline "" "_lw" "10.00" "") (foreach sublist bm (if (= (car sublist) 10) ; Look for vertex points (coded as 10). (if pt2 (command "DIMALIGNED" (setq pt1 pt2) (setq pt2 (cdr sublist)) "@5<180") (if pt1 (command "DIMALIGNED" pt1 (setq pt2 (cdr sublist)) "@5<180") (setq pt1 (cdr sublist)) ) ) ; end progn ) ; end if ) ; end foreach ) ; end progn ) )

Based on your way of processing, here is what I think is what you are after. (if (and (setq s (car (entsel "\nSelect LWpolyline : "))) (= (cdr (assoc 0 (setq bm (entget s)))) "LWPOLYLINE") ) (progn (foreach grp bm (if (= (car grp) 10) (setq pts (cons (cdr grp) pts)) ) ) (entmod (append bm '((370 . 10)))) (setq p1 (car pts)) (foreach pt (cdr pts) (command "DIMALIGNED" "_non" p1 "_non" pt "@0.35<180") (setq p1 pt) ) ) )

This is what I use and I am pretty sure it was posted by Lee-mac many years ago. (setq plent (entsel "\nPick pline ")) (if plent (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car plent)))))) so if you want pt1 pt2 (setq pt1 (car co-ord) pt2 (cadr co-ord)) You can also use the Vl functions getstartpoint & getendpoint

Steps as Lee Mac Suggests - Use ForEach to create a list of points (assoc 10) - End ForEach - Loop through list of points (n-1) times where n is the list length - Put in your dimension - End Loop Often there is a function out there that can 'plug and play' into a routine... below is a subfunction massoc which I find really handy, often using the 2nd option in the 2nd post... 'Key' in your case will be 10 lst in your case will be pdb (though you might be able to also use (entget bm) The return is a list of all the keys, in your case the points, I think in the format (10 pt-X pt-Y pt-Z), so (CADR... to get the points only.

Just make the iteration skip ahead while pt1 and pt2 are not assigned (if (= (cdr (assoc 0 bm)) "LWPOLYLINE") ; Check if the entity type is LWPOLYLINE (progn (setq pline (cdr (assoc -1 bm))) (setq pdb (entget pline)) ; Get the entity list for the selected polyline. (foreach sublist pdb (if (= (car sublist) 10) ; Look for vertex points (coded as 10). (progn (if pt2 (setq pt1 pt2 pt2 (cdr sublist)) (if pt1 (setq pt2 (cdr sublist)) (setq pt1 (cdr sublist)) ) ) ;;; (setq p1 (cdr sublist)) ; Get the point coordinates. ;;; (setq p2 (cadr sublist)) ;;;(command "_.chprop" pline "" "_lw" "10.00" "") (if (and pt1 pt2) (command "DIMALIGNED" pt1 pt2 "@0.35<180") ; Create aligned dimension. ) ) ; end progn ) ; end if ) ; end foreach ) ; end progn )

I made a 100 on the civil drafting assignment so i hope this helps others

Are they fields or attributes ? There is a big difference between the two. yes can update multiple blocks changing a single or more attributes across a dwg. If its fields then its more complicated Can you post a dwg ?

If your drawing stairs then why not use a Stair LIsp. There are plenty of examples out there just do a google, look for floor start pick point, end point floor above point. A lot of them have the rules of stair design built in. For me "The AS1657 standard provides dimensional “deemed to comply” requirements", there should be a standard for where you are in the world. Even here in Cadtutor look for "looking-for-lisp-draw-simple-stairs" you need to look for answers yourself.

This give a point at min z on 3Dpolyline. (vl-load-com) (defun c:min_z ( / js obj ename pr pt lst_pt lst_z id_seg nw_pt) (princ "\nSelect 3DPolylines: ") (while (null (setq js (ssget '((0 . "POLYLINE") (-4 . "&") (70 . 8))))) (princ "\nObjects not valid!") ) (repeat (setq n (sslength js)) (setq obj (ssname js (setq n (1- n))) ename (vlax-ename->vla-object obj) pr -1 lst_pt nil ) (repeat (if (zerop (vlax-get ename 'Closed)) (1+ (fix (vlax-curve-getEndParam ename))) (fix (vlax-curve-getEndParam ename))) (setq pt (vlax-curve-GetPointAtParam ename (setq pr (1+ pr))) lst_pt (cons pt lst_pt) ) ) (setq lst_z (mapcar 'caddr lst_pt) id_seg (- (length lst_z) (length (member (apply 'min lst_z) lst_z))) ) (setq nw_pt (vlax-invoke (if (eq (getvar "CVPORT") 1) (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) ) 'AddPoint (nth id_seg lst_pt) ) ) (vla-put-Normal nw_pt (vlax-3d-point '(0 0 1))) ) (prin1) )

Hi, I have this that could be used as an example for creating a dimension style. I hope this inspires you to create your own dimension style. (defun c:DimPline ( / adoc space obj_dim obj_angdim height_dim pl ent obj dxf_ent last_pt pr_pt lst_pt nw_obj) (vl-load-com) (setq adoc (vla-get-activedocument (vlax-get-acad-object)) space (if (= 1 (getvar "CVPORT")) (vla-get-paperspace adoc) (vla-get-modelspace adoc) ) obj_dim (vla-add (vla-get-Dimstyles adoc) "DIMPLINE") obj_angdim (vla-add (vla-get-Dimstyles adoc) "DIMANGPLINE") ) (vla-put-activedimstyle adoc obj_dim) (initget 6) (setq height_dim (getdist (getvar "VIEWCTR") (strcat "\nHeight of dimension text <" (rtos (getvar "DIMTXT")) ">: "))) (if height_dim (vla-setvariable adoc "DIMTXT" height_dim) (setq height_dim (getvar "DIMTXT"))) (mapcar '(lambda (data_list / ) (vla-setvariable adoc (car data_list) (cdr data_list))) (list (cons "DIMPOST" "") (cons "DIMAPOST" "") (cons "DIMSCALE" 1.0) (cons "DIMASZ" (getvar "DIMTXT")) (cons "DIMEXO" (* 0.625 (getvar "DIMTXT"))) (cons "DIMDLI" (* 3.75 (getvar "DIMTXT"))) (cons "DIMEXE" (* 1.25 (getvar "DIMTXT"))) (cons "DIMRND" 0.0) (cons "DIMDLE" 0.0) (cons "DIMTP" 0.0) (cons "DIMTM" 0.0) (cons "DIMFXL" (* 10.0 (getvar "DIMTXT"))) (cons "DIMFXLON" 1) (cons "DIMATFIT" 3) (cons "DIMTIX" 1) (cons "DIMCEN" (* 2.5 (getvar "DIMTXT"))) (cons "DIMTSZ" 0.0) (cons "DIMALTF" 0.0394) (cons "DIMLFAC" 1.0) (cons "DIMTVP" 0.0) (cons "DIMTFAC" 1.0) (cons "DIMGAP" (* 0.625 (getvar "DIMTXT"))) (cons "DIMALTRND" 0.0) (cons "DIMTOL" 0) (cons "DIMLIM" 0) (cons "DIMTIH" 0) (cons "DIMTOH" 0) (cons "DIMSE1" 0) (cons "DIMSE2" 0) (cons "DIMTAD" 1) (cons "DIMZIN" 0) (cons "DIMALT" 0) (cons "DIMALTD" 3) (cons "DIMTOFL" 1) (cons "DIMSAH" 0) (cons "DIMTIX" 0) (cons "DIMSOXD" 0) (cons "DIMCLRD" 0) (cons "DIMCLRE" 0) (cons "DIMCLRT" 0) (cons "DIMADEC" 2) (cons "DIMDEC" 2) (cons "DIMTDEC" 2) (cons "DIMALTU" 2) (cons "DIMALTTD" 3) (cons "DIMAUNIT" 0) (cons "DIMFRAC" 0) (cons "DIMLUNIT" 2) (cons "DIMDSEP" ".") (cons "DIMTMOVE" 0) (cons "DIMJUST" 0) (cons "DIMSD1" 0) (cons "DIMSD2" 0) (cons "DIMTOLJ" 0) (cons "DIMTZIN" 0) (cons "DIMALTZ" 0) (cons "DIMALTTZ" 0) (cons "DIMUPT" 0) (cons "DIMBLK" "_OBLIQUE") (cons "DIMBLK2" "_OBLIQUE") ) ) (vla-copyfrom obj_dim adoc) (vla-copyfrom obj_angdim adoc) (princ "\nSelect polylines: ") (while (null (setq pl (ssget '((0 . "LWPOLYLINE")))))) (repeat (setq n (sslength pl)) (setq ent (ssname pl (setq n (1- n))) obj (vlax-ename->vla-object ent) dxf_ent (entget ent) lst_pt (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_ent)) ) (if (not (zerop (logand 1 (cdr (assoc 70 dxf_ent))))) (setq last_pt (car lst_pt) lst_pt (cons (last lst_pt) lst_pt) pr_pt (last lst_pt)) (setq pr_pt nil) ) (while (cdr lst_pt) (vla-put-activedimstyle adoc obj_dim) (setq nw_obj (vla-addDimAligned space (vlax-3d-point (car lst_pt)) (vlax-3d-point (cadr lst_pt)) (vlax-3d-point (mapcar '(lambda (a b) (* (+ a b) 0.5)) (car lst_pt) (cadr lst_pt))) ) ) (vlax-put nw_obj 'TextPosition (polar (vlax-get nw_obj 'TextPosition) (+ (angle (car lst_pt) (cadr lst_pt)) (* 0.5 pi)) (* 3.25 (getvar "DIMTXT")))) (if pr_pt (progn (vla-put-activedimstyle adoc obj_angdim) (setq nw_obj (vla-AddDimAngular space (vlax-3d-point (car lst_pt)) (vlax-3d-point (polar (car lst_pt) (angle pr_pt (car lst_pt)) (distance pr_pt (car lst_pt)))) (vlax-3d-point (cadr lst_pt)) (vlax-3d-point (polar (car lst_pt) (+ (angle pr_pt (car lst_pt)) (* 0.5 (- (angle (car lst_pt) (cadr lst_pt)) (angle pr_pt (cadr lst_pt)))) ) (* 5.0 (getvar "DIMTXT")) ) ) ) pr_pt (car lst_pt) ) ) (setq pr_pt (car lst_pt)) ) (setq lst_pt (cdr lst_pt)) ) (if (cdr lst_pt) (setq nw_obj (vla-AddDimAngular space (vlax-3d-point (car lst_pt)) (vlax-3d-point (polar (car lst_pt) (angle pr_pt (car lst_pt)) (distance pr_pt (car lst_pt)))) (vlax-3d-point (cadr lst_pt)) (vlax-3d-point (polar (car lst_pt) (+ (angle pr_pt (car lst_pt)) (* 0.5 (- (angle (car lst_pt) (cadr lst_pt)) (angle pr_pt (car lst_pt)))) ) (* 5.0 (getvar "DIMTXT")) ) ) ) ) ) ) (princ) )

Is this a company problem, a few people, just you? What exactly is AutoCAD doing when the drawing is loading? Does it slowly start showing objects or does it hang and suddenly load? Are the files on a local drive, network or in the cloud? Computer specifications? Has IT looked into this? Without knowing more details, sounds like an Anti-virus and/or firewall issue. There used to be issues with AutoCAD after the computer goes to sleep and needing a password to reopen, but I don't remember all the details. https://www.autodesk.com/support/technical/article/caas/sfdcarticles/sfdcarticles/Program-crashes-using-random-commands.html Scroll to Issues not related to a specific drawing, though you should read it all anyway.

My mail box thinks you're spam , well punk are you? (with the voice of Clint Eastwood ) Oh I thought you wanted all ents inside block updated... silly me... good news is nos problemos, the bad news is , dragons never know when to stop and just have to go over the top so its gonna take more time before I'm satisfied (not the youngest dragon on the block anymore ya know)