Leaderboard

It is the same lisp, can you keep 1 thread about it? I think you got to restructure the lisp, break it downs to some levels, each function do some specific thing then it will easier to debug (defun get_objects_in_viewport (viewport /) ... the hard code goes here ... ss ;return the selectionset ) ;------------------------------------------ (defun change_dimension_accordingly (viewport /) (setq ss (get_objects_in_viewport viewport)) ... do the changing code here ... ) ;------------------------------------------ (defun C:maincommand (/ *error*) (defun *error* (msg) (princ msg) ;or do something here ... ) (setq allviewports (ssget ...)) (... loop through allviewports ... >>> (change_dimension_accordingly viewport) ) (princ) )

So a couple of things I noticed , the line you want to repeat from is inside your 3rd 'If' command, then that 'if' is finished and later you define what ss1 is... so that shouldn't affect anything (hoping I have read this right). If you are meaning your 'repeat' loop to do more than after the line (setvar "cvport" vpno) then I think you need to look at where the 'if' and 'progn' opening and closing brackets are. Also noticed that near the end, after this 'if' (if (= cscale 0.005) you define (setq i 0), but after the (if (= cscale 0.0100) you don't.. do you need to add that in there? For my first comment, I often find it handy to number my ifs, whiles, repeats as I go, keeping tabs on where you are... something like this@ Wonder if that helps at all (defun c:vpttt () (vpselttt "C") (princ) (command "_SELECT" "ALL" "") (Command "_.PSPACE") ) (defun c:vpwttt () (vpselttt "W") (princ) ) (defun dxf (n ed) (cdr (assoc n ed)) ) (defun vpselttt (typ / ad ss ent vpno ok vpbl vpur msbl msur msul mslr ss1 pl nlist x n) (vl-load-com) (setq ok t) (if (= (getvar "tilemode") 0) ;;if 1 (progn (setq ad (vla-get-activedocument (vlax-get-acad-object))) (if (= (getvar "cvport") 1) ;;if 2 (if (and (= (getvar "cmdactive") 0) (setq ss (ssget "_x" (list '(0 . "VIEWPORT")))) ) ;;if 3 (progn (setq ent (ssname ss Vindex)) ;;SUGGESTED REPEAT HERE (setq vpno (dxf 69 (entget ent))) (vla-Display (vla-get-activepviewport ad) :vlax-true) (vla-put-mspace ad :vlax-true) (setvar "cvport" vpno) ;;SUGGESTED REPEAT SHOULD END BY HERE ) (progn (setq ok nil) ) ) ;;end if 3 (setq ent (vlax-vla-object->ename (vla-get-activepviewport ad))) ) ;;end if 2 (if (and ok (/= 1 (logand 1 (dxf 90 (setq ed (entget ent)))))) ;;if 4 (progn (if (= (vla-get-clipped (vlax-ename->vla-object ent)) :vlax-false ) ;;if 5 (progn (vla-getboundingbox (vla-get-activepviewport ad) 'vpbl 'vpur ) (setq msbl (trans (vlax-safearray->list vpbl) 3 2)) (setq msur (trans (vlax-safearray->list vpur) 3 2)) (setq msul (list (car msbl) (cadr msur))) (setq mslr (list (car msur) (cadr msbl))) (setq ss1 (ssget (strcat typ "P") (list msbl msul msur mslr))) ) ) ;;end if 5 (sssetfirst nil ss1) (if ss1 ;;if 6 (setq n (sslength ss1)) (setq n 0) ) (princ n) (princ " found ") (if (and ss1 (= (getvar "cmdactive") 1)) ;;if 7 ss1 ) ) ) ;;end if 4 ) ) ;;end if 1 ;;; (setq ss nil ss1 nil) (setq data ss1) (setq cscale (vla-get-CustomScale (vlax-ename->vla-object (ssname ss 2)))) (if (= cscale 0.005) ;;if 8 (Progn (setq i 0) (repeat (sslength data) (setq e (ssname data i)) (if (and (< i (sslength data))(equal "DIMENSION" (cdr (assoc 0 (entget e)))) ) ;;if 9 (progn (setq entdimnstyle (entget e)) (setq newdim (subst (cons 3 "Dimension 200") (assoc 3 entdimnstyle) entdimnstyle )) (entmod newdim) (setq i (1+ i)) ) ) ;;end if 9 ) ;;end repeat ) ) ;;end if 8 (if (= cscale 0.0100) ;;if 10 (repeat (sslength data) (setq e (ssname data i)) (if (and (< i (sslength data))(equal "DIMENSION" (cdr (assoc 0 (entget e)))) ) ;;if 11 (progn (setq entdimnstyle (entget e)) (setq newdim (subst (cons 3 "Dimension 100")(assoc 3 entdimnstyle) entdimnstyle)) (entmod newdim) (setq i (1+ i)) ) ) ;;end if 11 (setq i (1+ i)) ) ;;end repeat ) ;;end if 10 (setq i (1+ i)) )

As it happens I found something else, the structure of my main list has errors in its assembly, and that has been causing the copy command and foreach to fail after the 1st copy was made. I have to take a break from this for a few days, I will let you know how things turn out next week. And your code was very helpful THANK YOU Allan

Yes, or at least it is in the Italian version...In the meantime, I have discovered a feature that can be useful to me: If during the execution of the command, before giving the second point with a click of the mouse, F3 is held down, the osnaps are disabled, but they are not turned off, so they are available again in the next command. for now I can try this way

I left the code alone. All I did was take the user selection (ssget) outside of the function. I made an extra function that does the ssget selection, then sorts it according to a few options (which can be easily expanded). You can sort from left to right for the vertical polylines (command rbrtab_x) , or from bottom to top for the horizontal ones (command rbrtab_y). Or sort by length which is what you want, I guess. (command rbrtab). (vl-load-com) (defun round ( value to ) (setq to (abs to)) (* to (fix (/ ((if (minusp value) - +) value (* to 0.5)) to))) ) ;; I (Emmanuel Delay) just took the SSGET outside of the function, so as to sort the SS first (defun TABELAZPRETOW (s / x y doc objtable numrows rowheight pt1 colwidth curspace) ;; Tharwat 26. 08. 2015 ; ;; mods by BIGAL 29.08.2015 now as table (setq doc (vla-get-activedocument (vlax-get-acad-object))) (setq curspace (vla-get-modelspace doc)) (setq pt1 (vlax-3d-point (getpoint "\nPick point for top left hand of table: "))) ;;(princ "\nSelect LWpolylines to export to a Table :") ;;(setq s (ssget '((0 . "LWPOLYLINE") (-4 . "=") (8 . "BZ_P_roz")))) ; tylko warstwa BZ_P_roz (if (/= s nil) (progn ; now do table (setq numrows (+ 2 (sslength s))) (setq numcolumns 2) (setq rowheight 60) ; wysokosc wiersza (setq colwidth 270) ;szerokosc kolumny powinna byc rowna pierwszej + drugiej (setq objtable (vla-addtable curspace pt1 numrows numcolumns rowheight colwidth)) (vla-settext objtable 0 0 "Prêt nr X") (vla-setcolumnwidth objtable 0 90) ;szerokosc pierwszej kolumny (vla-setcolumnwidth objtable 1 180) ;szerokosc drugiej kolumny (vla-settext objtable 1 0 "Lp.") (vla-settext objtable 1 1 "D³ugoœæ") ; aby byly polskie znaki kodowwanie w zapisanym pliku txt (lsp) musi byc ansi (widac w prawym dolnym rogu) (vla-SetTextHeight Objtable (+ acDataRow acHeaderRow acTitleRow) 40) ;wysokosc tekstu (vla-SetAlignment Objtable acDataRow acMiddleCenter) (setq x 1) (SETQ Y 2) (setq r -1) ;((lambda (r / e) (while (setq e (vlax-ename->vla-object(ssname s (setq r (1+ r))))) (vla-settext objtable Y 0 (rtos x 2 0)) ; dokladnosc numeracji Lp. (vla-settext objtable Y 1 (rtos (round (vla-get-length e) 5) 2 0)) ; 2 i 0 to dzisietny i dokladnosc, dalej mozna równiez zkonwertowaæ jednostki. Tutaj mm na mm. to 5 za e wskazuje do jakiej liczby zaokraglamy. korzystajac z zdefiniowanej funkcji round (setq x (1+ x )) (setq y (1+ Y )) ); while ; )) ;lambda ) ;progn (alert "You have not picked any plines run again") ) ; if (princ) ) ; defun ;; @param sortby: l/x/y (Length/X/Y) (defun TABELAZPRETOW_prep (sortby / s s2 i ent xlist ylist lengthlist ip len sortindexes) ;; user selects the polylines (princ "\nSelect LWpolylines to export to a Table : ") (setq s (ssget (list (cons 0 "LWPOLYLINE") (cons 8 "BZ_P_roz")))) ; tylko warstwa BZ_P_roz ;; Now we sort. We make a list of just the x and a list of the y values. (setq i 0) (setq xlist (list)) (setq ylist (list)) (setq lengthlist (list)) (repeat (sslength s) (princ "\n") (setq ent (ssname s i)) (setq ip (vlax-curve-getendpoint (vlax-ename->vla-object ent))) (setq len (vla-get-length (vlax-ename->vla-object ent))) (setq xlist (append xlist (list (nth 0 ip)))) (setq ylist (append ylist (list (nth 1 ip)))) (setq lengthlist (append lengthlist (list len))) (setq i (+ i 1)) ) ;; Now sort the data by length, or X or Y value. Whatever you need. ;; (vl-sort-i) returns the indexes instead of returning the values ;; you can easily add option. For example from big to small ... (if (= sortby "l") (setq sortindexes (vl-sort-i lengthlist '<)) ) (if (= sortby "x") (setq sortindexes (vl-sort-i xlist '<)) ) (if (= sortby "y") (setq sortindexes (vl-sort-i ylist '<)) ) ;; now we make a new list of items, sorted by whatever we picked (setq s2 (ssadd)) (setq i 0) (repeat (sslength s) (ssadd (ssname s (nth i sortindexes)) s2) (setq i (+ i 1)) ) ;; and we pass s2 to the function instead of s (TABELAZPRETOW s2) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; sorted by x (defun c:rbrtab_x () (TABELAZPRETOW_prep "x") ) ;; sorted by y (defun c:rbrtab_y () (TABELAZPRETOW_prep "y") ) ;; sorted by length (defun c:rbrtab () (TABELAZPRETOW_prep "l") )

Not that great at making tables so used @confutatis code from this post. Will ask to select polylines then what side you want to start from. sort according to answer and then ask for point to create table. seemed small so i had to scale it up by 10. isn't quite like your table so maybe confutais can come in and fix that part. Updated code pulled from lisp attached. also added numbering of lines to double check for correct lengths. (defun C:AddLengthTable (/ ss poly ent lst side lenlst pt objtable index c) (vl-load-com) (if (setq SS (ssget '((0 . "*POLYLINE")))) (foreach poly (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) (setq ent (entget poly)) (setq lst (cons (list (cdr (assoc 10 ent)) (cdr (assoc -1 ent))) lst)) ;build list with point and entity name ) ) (initget "Left Right Top Bottom") (setq side (cond ((getkword "\nStarting Side? [Left,Right,Top,Bottom]: ")) ( "Left") ) ) (if lst (progn (cond ((= "Left" side) (setq lst (vl-sort lst '(lambda (r j) (> (caar r) (caar j))))) ) ((= "Right" side) (setq lst (vl-sort lst '(lambda (r j) (< (caar r) (caar j))))) ) ((= "Top" side) (setq lst (vl-sort lst '(lambda (r j) (< (cadr (car r)) (cadr (car j)))))) ) ((= "Bottom" side) (setq lst (vl-sort lst '(lambda (r j) (> (cadr (car r)) (cadr (car j)))))) ) ) (setq c (Length lst)) (foreach ent lst (setq lenlst (cons (vla-get-length (vlax-ename->vla-object (cadr ent))) lenlst)) (entmake (list (cons 0 "TEXT") (cons 10 (car ent)) (cons 40 40) (cons 1 (itoa c)) ) ) (setq c (1- c)) ) (setq pt (getpoint "\nSelect point insertion table: ") objtable (vla-AddTable (vla-get-modelspace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3d-Point pt) (+ 2 (sslength ss)) 2 60 270) index 1 c 0 ) (vla-settext objtable 0 0 "Prêt nr X") (vla-SetCellTextHeight objtable 0 0 40) (vla-SetCellAlignment objtable 0 0 acMiddleCenter) (vla-setcolumnwidth objtable 0 120) (vla-setcolumnwidth objtable 1 300) (vla-settext objtable 1 0 "Lp.") (vla-SetCellTextHeight objtable 1 0 40) (vla-SetCellAlignment objtable 1 0 acMiddleCenter) (vla-settext objtable 1 1 "D³ugoœæ") (vla-SetCellTextHeight objtable 1 1 40) (vla-SetCellAlignment objtable 1 1 acMiddleCenter) (foreach elem lenlst (setq c (1+ c)) (vla-SetText objtable (setq index (1+ index)) 0 c) (vla-SetCellTextHeight objtable index 0 40) (vla-SetCellAlignment objtable index 0 acMiddleCenter) (vla-SetText objtable index 1 (rtos elem 2 0)) (vla-SetCellTextHeight objtable index 1 40) (vla-SetCellAlignment objtable index 1 acMiddleCenter) ) ) ) (princ) )

The easiest is to sort say on length. (setq s (ssget '((0 . "LWPOLYLINE") (-4 . "=") (8 . "BZ_P_roz")))) ok now make a list of the rebar properties say by length then sort on length. Ps dont need -4 as layer correct filter. ((120)(2400)(1586)..... Same again but make list with (X Y length) so could do sort on X for vertical bars and sort Y for Horizontal bars need choice. ((x y len) (123.45 56.7 1234)..... or sort on length. replace (while (setq e (vlax-ename->vla-object(ssname s (setq r (1+ r))))) (foreach val lst ;reading the length in the list so (X Y len) use (nth 2 val) (vla-settext objtable Y 1 (rtos (round (nth 2 val) 5) 2 0))

A few sites I trust besides Cadtutor: http://www.lee-mac.com/programs.html https://www.afralisp.net/ https://jtbworld.com/autolisp-visual-lisp https://autolisp-exchange.com/ https://gilecad.azurewebsites.net/Lisp.aspx Got to be responsible though put them in a folder in both the Support File Search Path and Trusted Folders. I also don't download any compiled code, lisp and dcl only.