Leaderboard

A big hint. With real big table creation you sit there and watch the wheels turning but if you set (vla-put-regeneratetablesuppressed obj :vlax-true) the table will be made in like a second or 2 for say 500 rows. You need to set the value to false to see result. So making a new table is possible.

Like this, perhaps... (defun c:BlockEnts ( / Blk MyBlocks MySS Ent ) (while (setq Blk (tblnext "block" (not Blk))) ;; Get all blocks (setq MyBlocks (cons (cdr (assoc 2 Blk)) MyBlocks)) ) (foreach Blk MyBlocks (setq MySS (ssadd)) ;; Blank SS (setq Ent (tblobjname "block" Blk)) ;; Block definition entitiy name (while (setq Ent (entnext Ent)) ;; Loop block entities (ssadd Ent MySS) ;; Add Ent to selection set (princ Ent) ;; Check that it found an entity ) ;;Do stuff here;; (princ " : ") ;; Check SS length (princ (sslength MySS)) (princ "\n") ) ; end foreach (princ) )

@Steven P Why use a Selection set? Why not just build a list of entity names for each block and iterate through them?

I don't think the person with the problem should get any credit..... Big, Gigantic, Massive kudo's to Steven P here..... (and also to Lee, ronjonp, BigAl, mhupp, Tharwat, hanhphuc, SLW210, rlx, and SO MANY MORE who have helped me in the past!!!!!!)

Look below his name on the left

Here is my solution. (defun c:3Dppad ( / js pad total_horizontal_length l_pt pt_start pt_end inter_dist n start_z end_z ratio num_points) (princ "\nOdaberite 3D poliliniju.") ;; Selektovanje 3D polilinije (setq js (ssget '((0 . "POLYLINE")))) ; Samo polilinije ;; Proverava da li je izbor prazan (if (not js) (progn (princ "\nNeprazan ili nevalidan izbor polilinije!") (exit) ;; Izlazi iz komande ) ) ;; Dobijanje VLA objekta za odabranu poliliniju (setq ename (vlax-ename->vla-object (ssname js 0))) ;; Računanje ukupne horizontalne dužine polilinije (X, Y ravnina) (setq total_horizontal_length 0.0) (setq num_points (fix (vlax-curve-getEndParam ename))) ;; Ukupan broj verteksa ;; Provera da li polilinija ima verteksa (if (<= num_points 0) (progn (princ "\nPolilinija nema validne vertekse!") (exit) ) ) ;; Petlja za računanje horizontalne dužine (setq n 0) (while (< n num_points) (setq pt_start (vlax-curve-getPointAtParam ename (float n)) ;; Početna tačka na n-tom verteksu pt_end (vlax-curve-getPointAtParam ename (float (1+ n))) ;; Sledeća tačka ;; Provera da li su tačke validne inter_dist 0.0 ) ;; Ako su obe tačke validne (if (and pt_start pt_end) (progn ;; Izračunaj horizontalnu distancu (setq inter_dist (distance (list (car pt_start) (cadr pt_start)) (list (car pt_end) (cadr pt_end))) ;; Horizontalna distanca total_horizontal_length (+ total_horizontal_length inter_dist)) ;; Dodaj horizontalnu distancu ;; Ispis horizontalne dužine do trenutnog verteksa (princ (strcat "\nHorizontalna dužina do verteksa " (itoa n) " je: " (rtos total_horizontal_length 2 2) " jedinica.")) ) ) (setq n (1+ n)) ) ;; Dobavljanje željenog nagiba od korisnika (setq pad (getreal "\nUnesite željeni pad (slope) u procentima: ")) (setq pad (/ pad -100.0)) ;; Pretvaranje u decimalni oblik ;; Računanje visine na osnovu nagiba (pad * ukupna horizontalna dužina) (setq start_z (getreal "\nUnesite Z koordinatu početne tačke: ")) (setq end_z (+ start_z (* pad total_horizontal_length))) ;; Z koordinata poslednje tačke ;; Kreiranje liste za nove tačke (setq l_pt '()) ;; Interpolacija visina između prve i poslednje tačke (setq n 0) (setq horizontal_length_so_far 0.0) ;; Horizontalna dužina do trenutnog verteksa (while (<= n num_points) (setq pt_start (vlax-curve-getPointAtParam ename (float n))) ;; Dohvata n-tu tačku ;; Provera validnosti tačke (if pt_start (progn ;; Sprečavanje deljenja sa nulom (if (>= num_points 0) (setq ratio (/ horizontal_length_so_far total_horizontal_length)) ;; Izračunaj ratio (setq ratio 0.0) ) ;; Interpolacija Z koordinate uzimajući u obzir horizontalnu dužinu do verteksa (setq interpolated_z (+ start_z (* ratio (- end_z start_z)))) ;; Interpolacija Z ;; Dodaj novu tačku s novom Z koordinatom u listu (setq l_pt (cons (list (car pt_start) (cadr pt_start) interpolated_z) l_pt)) ) ) ;; Dodaj horizontalnu dužinu trenutnog verteksa (if (<= n (1- num_points)) ;; Osigurati da ne idemo van granica (setq next_pt_start (vlax-curve-getPointAtParam ename (float (1+ n))) ;; Sledeća tačka inter_dist (distance (list (car pt_start) (cadr pt_start)) (list (car next_pt_start) (cadr next_pt_start))) ;; Horizontalna distanca horizontal_length_so_far (+ horizontal_length_so_far inter_dist)) ;; Akumuliraj horizontalnu dužinu ) (setq n (1+ n)) ) ;; Kreiranje nove 3D polilinije sa zadatim nagibom (vla-put-Layer (vlax-invoke (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) 'Add3DPoly (apply 'append (reverse l_pt))) (vla-get-Layer (ssname js 0))) (princ "\nNova 3D polilinija je uspešno kreirana sa zadatim nagibom.") (princ) ;; Završavanje funkcije bez greške )

@AirBall With your request :elevations in vertices Try this for convert your lwpolyline to 3Dpoly with 3Dfaces (defun pt_sum_store (pt? pt_lst / count p1 p2 vtx alpha btw_alpha) (setq alpha 0.0 vtx (car pt_lst) count 1 ) (while (< 1 (length pt_lst)) (setq p1 (car pt_lst) p2 (cadr pt_lst) pt_lst (cdr pt_lst) btw_alpha (q_ang pt? p1 p2) btw_alpha (if (< 180.0 btw_alpha) (- btw_alpha 360.0) btw_alpha ) alpha (+ alpha btw_alpha) ) (setq count (1+ count)) ) (setq btw_alpha (q_ang pt? p2 vtx) btw_alpha (if (< 180.0 btw_alpha) (- btw_alpha 360.0) btw_alpha ) ) (+ alpha btw_alpha) ) (defun q_ang (pt? p1 p2 / alpha beta) (setq beta (angle pt? p1) alpha (angle pt? p2) alpha (- alpha beta) ) (if (< alpha 0) (setq alpha (+ (* 2 pi) alpha)) ) (* (/ (float alpha) pi) 180.0) ) (defun pt_in_poly (pt? pt_lst / ) (if (equal 0.0 (pt_sum_store pt? pt_lst) 0.0001) nil T ) ) (vl-load-com) (defun c:lwpolyto3dpoly ( / js AcDoc Space ename obj pr lst_pt ss nb ent dxf_ent l_pt n X1 X2 X3 Y1 Y2 Y3 Z1 Z2 Z3 E1 E2 E3 E4 Z nw_lst-pt nw_obj) (princ "\nSelect polyline.") (while (null (setq js (ssget "_+.:E:S" (list (cons 0 "*POLYLINE") (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) (cons -4 "<NOT") (cons -4 "&") (cons 70 112) (cons -4 "NOT>") ) ) ) ) ) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (setq ename (ssname js 0) obj (vlax-ename->vla-object ename) pr -1 ) (repeat (fix (vlax-curve-getEndParam obj)) (setq pr (1+ pr) lst_pt (cons (vlax-curve-GetPointAtParam obj pr) lst_pt) ) ) (setq lst_pt (cons (vlax-curve-GetPointAtParam obj (1+ pr)) lst_pt)) (setq ss (ssget "_F" lst_pt '((0 . "3DFACE")))) (cond (ss (repeat (setq nb (sslength ss)) (setq ent (ssname ss (setq nb (1- nb))) dxf_ent (entget ent) l_pt (list (cdr (assoc 10 dxf_ent)) (cdr (assoc 11 dxf_ent)) (cdr (assoc 12 dxf_ent)) (cdr (assoc 13 dxf_ent)) ) ) (if (equal (car l_pt) (cadr l_pt)) (setq l_pt (list (list (cadr l_pt) (caddr l_pt) (cadddr l_pt)))) (setq l_pt (cons (list (car l_pt) (cadr l_pt) (caddr l_pt)) (list (list (cadr l_pt) (caddr l_pt) (cadddr l_pt))))) ) (mapcar '(lambda (y / n) (foreach e lst_pt (cond ((pt_in_poly e y) (setq n 0) (foreach item '(("X" . "'car") ("Y" . "'cadr") ("Z" . "'caddr")) (mapcar '(lambda (e) (set (read (strcat (car item) (itoa (setq n (1+ n))))) e)) (mapcar (eval (read (cdr item))) (car l_pt)) ) (setq n 0) ) (setq E1 (+ (* X1 (- Y2 Y3)) (* X2 (- Y3 Y1)) (* X3 (- Y1 Y2))) E2 (+ (* Y1 (- Z2 Z3)) (* Y2 (- Z3 Z1)) (* Y3 (- Z1 Z2))) E3 (+ (* Z1 (- X2 X3)) (* Z2 (- X3 X1)) (* Z3 (- X1 X2))) E4 (- (- (* E2 X1)) (* E3 Y1) (* E1 Z1)) Z (- (- (* (/ E2 E1) (car e))) (* (/ E3 E1) (cadr e)) (/ E4 E1)) nw_lst-pt (cons (trans (list (car e) (cadr e) Z) 1 0) nw_lst-pt) ) ) ) ) ) l_pt ) ) (setq nw_obj (vlax-invoke Space 'Add3dPoly (apply 'append nw_lst-pt ) ) ) (vla-put-Layer nw_obj (vla-get-Layer obj)) (vla-put-Color nw_obj (vla-get-Color obj)) (vla-put-Lineweight nw_obj (vla-get-Lineweight obj)) (vla-delete obj) ) ) (prin1) )

I will have another look at it using *LINE will detect plines but did find another problem on a certain pattern of linework. Updated. ; Fillets multi lines in one go ;By Alan H (defun AH:Fmulti ( / ss fpts num num2 x y) (alert "pick outside-inside-outside") (setq fpts '()) (setq pt1 (getpoint "Pick outside ")) (setq fpts (cons pt1 fpts)) (setq pt1 (getpoint pt1 "Pick inside ")) (setq fpts (cons pt1 fpts)) (setq fpts (cons (getpoint pt1 "Pick outside ") fpts)) (setq ss (ssget "F" fpts (list (cons 0 "*LINE")))) (princ (sslength ss)) (setq num (sslength ss)) (setq num2 (/ num 2.0)) (if (= (- (fix num2) num2) 0.5) (progn (Alert "you have an odd number of lines please check") (exit) ) ) (setq x 0) (setq y (- num 1)) (setvar "filletrad" 0.0) (repeat (fix num2) ; not a real (setq obj1 (ssname ss x)) (setq obj2 (ssname ss y)) (command "fillet" obj1 obj2) (setq x (+ x 1)) (setq y (- y 1)) ) ) ; defun (AH:fmulti) Will improve a bit more.

This has been a long time problem in calling the FILLET command within AutoLISP (Google it - there is allot of forum posts out there). When typing in the FILLET at the command line in AutoCAD, it works with Polylines, but it doesn't work when called inside a (command) statement. As far as I can tell, noone has provided a solution, other than using direct object manipulation (via ENTMOD or with VLA; joining and setting bulges). EDIT: NOTE - it will work for me if the Polylines are 2 separate objects, but if they are already connected into a single object at the corner, it won't work.

i also tried it, it is working. You just need to adjust it a little to your needs. If your autocad language is not english, you need to add an underscore for the ssget "F" so "_F" and for the filet command. Also you would need to change the ssget filter to use lwpolylines instead of lines and add a pedit command to actually join them after the fillet. Edit: ok its not working with lwpolyline tough i dont get why

you could rewrite your while loops to : (while (and (> i 0) (not (wcmatch (substr textstring i 1) "#"))) (setq i (1- i))) (while (and (> i 0) (wcmatch (substr textstring i 1) "#")) (setq i (1- i))) this may fix some or all of your problems , it depends on the format of your texts. If your text ends with some letters you still have to append those too. for example (I disabled entsel and replaced it with a fix text) (defun c:IncrementTextNumber ( / ent entData textString i numEnd numStart numericPart numberValue newNumberValue newNumericPart newTextString ) ;(setq ent (car (entsel "\nSelect the text to increment: "))) ; Select the text entity (setq ent t) (if ent (progn ;(setq entData (entget ent)) ; Get the entity data ;(setq textString (cdr (assoc 1 entData))) ; Extract the text string ;;; *** testing (setq textString "123abc456def789ghi") ;; Find the position of the last numeric part (setq i (strlen textString)) ;(while (and (> i 0) (not (numberp (atoi (substr textString i 1))))) (setq i (1- i)) ) (while (and (> i 0) (not (wcmatch (substr textstring i 1) "#"))) (setq i (1- i))) ;; Find the start of the numeric part (setq numEnd i) ;(while (and (> i 0) (numberp (atoi (substr textString i 1)))) (setq i (1- i)) ) (while (and (> i 0) (wcmatch (substr textstring i 1) "#")) (setq i (1- i))) (setq numStart (+ i 1)) ;; Extract and increment the number (setq numericPart (substr textString numStart (- numEnd numStart -1))) (setq numberValue (atoi numericPart)) (setq newNumberValue (+ numberValue 1)) ;; Keep leading zeros (setq newNumericPart (rtos newNumberValue 2 0)) (while (< (strlen newNumericPart) (strlen numericPart)) (setq newNumericPart (strcat "0" newNumericPart)) ) ;; Replace the old number with the new number (setq newTextString (strcat (substr textString 1 (1- numStart)) newNumericPart)) (if (< numEnd (strlen textstring)) (setq newTextString (strcat newTextString (substr textString (1+ numEnd))))) ;| ;; Update the text in the drawing (entmod (subst (cons 1 newTextString) (assoc 1 entData) entData)) (entupd ent) |; (alert (strcat "Org. text : " (vl-princ-to-string textString) "\nNew text : " (vl-princ-to-string newTextString))) (princ "\nText updated successfully.") ) (princ "\nNo text selected.") ) (princ) ) (c:IncrementTextNumber)

Why don't you use qdim command ? It's more shorter for coding (defun c:drs()(command "qdim" (ssget) "" "Radius"))