Leaderboard

;;; 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) )

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.

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

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)) ) )

Thanks for introducing me to Ray-Casting. To my shame , I must say I wasn't aware of such an algorithm. In return, I can say I came to a similar conclusion years ago. But my algorithm works to the right and left of the reference point, for safety's sake.

Yes @GLAVCVS, that is right, I know it. You can change the text height, and it will included in the selection set (if it still don't touching the boundary from polyline), and the second one can be, if you get a nil from the first ssget with _WP, you can make a selection set with _F (if the text touching the boundary from polyline). Anyway, it's on the @maahee to choose the right way to accomplish what he need.

It seems there is a confusion now with the topic. Point inside a closed polyline and select points inside a closed polyline, which is which? . Either way, for the first one, I can say by experience, Ray-Casting is the best and fastest approach. For the second one, @Saxlle hit it right, just as the OP wanted.

I usually work with dynamic input, and all prompts for ssget appear in the command line if dynamic input is off. Over the years, I'm still waiting for this feature to be added. .

This conversation is very interesting. Marko's concept is interesting. But it has two weaknesses: - If "boundary" doesn't work or works poorly (this often happens in complex drawings), the code fails. - If the point is close to the polyline and there are any odd vertices on the polyline, the following may occur in some cases:

Welcome to Cadtutor Vostro 1500! I (still) have disabled all messages from this site (gives me more rest / spare time ) As for your question , yes its a big dialog , so either get a bigger monitor , or maybe set yours to a higher resolution , no other way I'm afraid... sorry

I made something. See if it can be useful to you. - It will copy "Layout1" multiple times, and name them "Paper1", "Paper2", ... So prepare the pagesetup of Layout1. Remove the viewport (new viewports will be created), but you can add a cartouche (or whatever you need there) Command ALS (for Automatic Layout Setup) - user set the length, height and overlap (for example 800 500 50). - user selects a polyline. -> Along the polyline rectangles (polylines) are created. -> Paper spaces are created, each with a viewport the same size as the rectangles. -> Each viewport pans/zooms (scale is set to 1.00) to a next rectangle Try it on my dwg first (vl-load-com) ;; https://www.cadtutor.net/forum/topic/18257-entmake-functions/ (defun LWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst))) ) ;; based on @see http://www.lee-mac.com/totallengthandarea.html (defun totalLengthPolyline ( s / i) (setq l 0.0) (repeat (setq i (sslength s)) (setq e (ssname s (setq i (1- i))) l (+ l (vlax-curve-getdistatparam e (vlax-curve-getendparam e))) ) ) l ) ;;;;;;;;;;;;;;;;;;;;;; (defun vat (viewport_length viewport_height overlap / obj pline total_length needle mp1 mp2 ang1 rec1 rec2 rec3 rec4) ;; settings ;;(setq viewport_length 700.0) ;;(setq viewport_height 400.0) ;;(setq overlap 50.0) ;; (princ "\nSelect Polytine") (setq pline (ssget (list (cons 0 "LWPOLYLINE,POLYLINE")) )) (setq obj (vlax-ename->vla-object (ssname pline 0))) (princ (setq total_length (totalLengthPolyline pline)) ) (setq needle 0.0) (while (< needle total_length) ;; (+ total_length viewport_length) (setq mp1 (vlax-curve-getPointAtDist obj needle)) (setq needle (+ needle viewport_length)) (setq mp2 (vlax-curve-getPointAtDist obj needle)) ;; last point, take the end of the polyline (if (= mp2 nil) (setq mp2 (vlax-curve-getPointAtDist obj total_length)) ) (setq ang1 (angle mp1 mp2)) (setq rec1 (polar mp2 (+ ang1 (/ pi 2)) (/ viewport_height 2))) (setq rec2 (polar rec1 (+ ang1 pi) viewport_length)) (setq rec3 (polar rec2 (+ ang1 (* pi 1.5)) viewport_height)) (setq rec4 (polar rec3 ang1 viewport_length)) ;; fill in the globals (setq LWPolylines_data (append LWPolylines_data (list (list rec1 rec2 rec3 rec4) ))) (setq LWPolylines (append LWPolylines (list (LWPoly (list rec1 rec2 rec3 rec4) 1) ))) (setq pointpairs (append pointpairs (list (list mp1 mp2) ))) (setq needle (- needle overlap)) ) (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; c:copying-lay-out ;; It will name the layouts "Paper1", "Paper2", ... (defun clo (pointpairs / i n layoutname ) (if (and (setq layoutname "Layout1") (setq n (length pointpairs)) ;; number of new layouts (setq i (+ n 1)) (member layoutname (layoutlist)) ) (repeat n (command "layout" "Copy" layoutname (strcat "Paper" (rtos (setq i (- i 1)))) ) );; repeat );; if (princ) );; demo (defun AlignView (p1 p2 / ang) ;;(command "ucs" "world" "\\") (and ;;(setq p1 (getpoint "\nFirst alignment point: ")) ;;(setq p2 (getpoint p1 "\nSecond alignment point: ")) (setq ang (- (angle (trans p1 1 0) (trans p2 1 0)))) (command "_.dview" "" "_twist" (angtos ang (getvar 'aunits) 16) "") ) (command "ucs" "view" "\\") (princ) ) ;; rotate view (defun rv (1point 2point / ) (command "_ucs" "_w") (if (and 1point 2point) (progn (command "_zoom" "_c" 1point "") (if (= (getvar "angdir") 0) (command "_dview" "" "_tw" (angtos (+ (* -1 (angle 1point 2point)) (getvar "angbase"))(getvar "aunits") 10) "") (command "_dview" "" "_tw" (angtos (+ (angle 1point 2point) (getvar "angbase")) (getvar "aunits") 10) "") ) (setvar "snapang" (angle 1point 2point)) );progn (progn (command "_dview" "" "_tw" "0" "") (setvar "snapang" 0.0) );progn ) (command "_ucs" "_w") (princ) );end defun ;; globals (setq pointpairs (list)) (setq LWPolylines (list)) (setq LWPolylines_data (list)) (defun ALS (viewport_length viewport_height overlap / i pair pt1 pt2) ;; settings ;;(setq viewport_length 800.0) ;;(setq viewport_height 500.0) ;;(setq overlap 50.0) ;; (re) initiate globals (setq LWPolylines (list)) (setq LWPolylines_data (list)) (setq pointpairs (list)) (vat viewport_length viewport_height overlap) (clo pointpairs) (princ LWPolylines_data) (setq i 0) (foreach pair pointpairs (setvar "ctab" (strcat "Paper" (itoa (+ i 1) ))) ;; This example creates a paper space viewport and makes it active. (setq acadObj (vlax-get-acad-object)) (setq doc (vla-get-ActiveDocument acadObj)) (setq centerPoint (vlax-3d-point (/ viewport_length 2.0) (/ viewport_height 2.0) 0) height viewport_height width viewport_length) ;; Create a paper space Viewport object (vla-put-ActiveSpace doc acPaperSpace) (setq newPViewport (vla-AddPViewport (vla-get-PaperSpace doc) centerPoint width height)) (vla-ZoomAll acadObj) (vla-Display newPViewport :vlax-true) ;; Before making a pViewport active, ;; the mspace property needs to be True (vla-put-MSpace doc :vlax-true) (vla-put-ActivePViewport doc newPViewport) (rv (nth 0 pair) (nth 1 pair)) ;; pt1 pt2 ;zoom window (setq pt1 (nth 2 (nth i LWPolylines_data))) (setq pt2 (nth 0 (nth i LWPolylines_data))) (command "zoom" "_o" (nth i LWPolylines) "") (vla-put-MSpace doc :vlax-false) (vla-put-customscale newPViewport 1.0) ;;(command "_.PSPACE") ;;(command "ucs" "world" "\\") (setq i (+ i 1)) ) ) ;; Automatic layout setup (defun c:ALS2 ( / viewport_length viewport_height overlap ) ;; settings (setq viewport_length 800.0) (setq viewport_height 500.0) (setq overlap 50.0) (ALS viewport_length viewport_height overlap ) ) ;; Automatic layout setup (defun c:ALS ( / ) (ALS (getreal "\nViewport length: ") (getreal "\nViewport height: ") (getreal "\noverlap: ") ) ) viewports_along_track.dwg