Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 06/13/2019 in all areas

  1. For primary entities only, use a combination of tblobjname & entnext: (defun blockcomponents ( blk / ent lst ) (if (setq ent (tblobjname "block" blk)) (while (setq ent (entnext ent)) (setq lst (cons ent lst)) ) ) (reverse lst) ) Call the above with a block name argument, e.g.: _$ (blockcomponents "YourBlockName") (<Entity name: 7ffff706950> <Entity name: 7ffff706960> <Entity name: 7ffff706970>) To include nested objects, check for the presence of a block reference (INSERT) entity and include a recursive call, e.g.: (defun blockcomponents ( blk / ent enx lst ) (if (setq ent (tblobjname "block" blk)) (while (setq ent (entnext ent)) (if (= "INSERT" (cdr (assoc 0 (setq enx (entget ent))))) (setq lst (vl-list* (blockcomponents (cdr (assoc 2 enx))) ent lst)) (setq lst (cons ent lst)) ) ) ) (reverse lst) ) The above will return a list of entity names with sublists containing the entity names corresponding to the components of nested block references, e.g.: _$ (blockcomponents "block1") (<Entity name: 7ffff7069f0> <Entity name: 7ffff706a00>) _$ (blockcomponents "block2") (<Entity name: 7ffff706a50> (<Entity name: 7ffff7069f0> <Entity name: 7ffff706a00>) <Entity name: 7ffff706a60> <Entity name: 7ffff706a70>) _$ (blockcomponents "block3") (<Entity name: 7ffff706ad0> (<Entity name: 7ffff706a50> (<Entity name: 7ffff7069f0> <Entity name: 7ffff706a00>) <Entity name: 7ffff706a60> <Entity name: 7ffff706a70>) <Entity name: 7ffff706ae0> <Entity name: 7ffff706af0>) Here, Block1 is nested within Block2 is nested within Block3. If you don't want the nested list structure, use append in place of vl-list*, e.g.: (defun blockcomponents ( blk / ent enx lst ) (if (setq ent (tblobjname "block" blk)) (while (setq ent (entnext ent)) (if (= "INSERT" (cdr (assoc 0 (setq enx (entget ent))))) (setq lst (append (blockcomponents (cdr (assoc 2 enx))) (cons ent lst))) (setq lst (cons ent lst)) ) ) ) (reverse lst) ) This now returns a flat list: _$ (blockcomponents "block1") (<Entity name: 7ffff7069f0> <Entity name: 7ffff706a00>) _$ (blockcomponents "block2") (<Entity name: 7ffff706a50> <Entity name: 7ffff706a00> <Entity name: 7ffff7069f0> <Entity name: 7ffff706a60> <Entity name: 7ffff706a70>) _$ (blockcomponents "block3") (<Entity name: 7ffff706ad0> <Entity name: 7ffff706a70> <Entity name: 7ffff706a60> <Entity name: 7ffff7069f0> <Entity name: 7ffff706a00> <Entity name: 7ffff706a50> <Entity name: 7ffff706ae0> <Entity name: 7ffff706af0>)
    1 point
  2. To change the number of decimal places, change line 6. It says (setq __PV_DP (getvar "LUPREC")) ; decimal places Remove the part that says (getvar "LUPREC") and replace it with 2 (or however many). You can also keep this line and change the precision with the UNITS command, which is where the routine gets this number. To remove the Z coordinate, remove the text (lines 19 and 20) that says __PV_Delimiter (rtos (caddr PT1) 2 __PV_DP) Make sure you keep the two parentheses at the end of the second line. You will get an error if they are missing.
    1 point
  3. I think OP wanted to learn something new... And BTW. LWPOLYLINE can have more than 2 arced segments... Perhaps OP wanted to find all quadrant points and sort them by Y of OCS of LWPOLYLINE... (defun c:minmaxYarcedsegsLW ( / LM:Bulge->Arc lw lwx k dxf10l dxf42l l v1 v2 bul b->a pl ) ;; Bulge to Arc - Lee Mac - mod by M.R. ;; p1 - start vertex ;; p2 - end vertex ;; b - bulge ;; Returns: (<center> <start angle> <end angle> <radius>) (defun LM:Bulge->Arc ( p1 p2 b / a c r ) (setq a (* 2 (atan (abs b))) r (abs (/ (distance p1 p2) 2 (sin a))) c (if (minusp b) (polar p2 (+ (- (/ pi 2) a) (angle p2 p1)) r) (polar p1 (+ (- (/ pi 2) a) (angle p1 p2)) r)) ) (list c (angle c p1) (angle c p2) r) ) (while (or (not (setq lw (car (entsel "\nPick LWPOLYLINE with arced segemnts that lie in WCS...")))) (if lw (or (/= (cdr (assoc 0 (setq lwx (entget lw)))) "LWPOLYLINE") (vl-every '(lambda ( x ) (equal (cdr x) 0.0 1e-6)) (vl-remove-if '(lambda ( x ) (/= (car x) 42)) lwx)) ) ) ) (prompt "\nMissed or picked wrong entity type or picked LWPOLYLINE with all straight segemnts...") ) (setq k -1) (setq dxf10l (vl-remove-if '(lambda ( x ) (/= (car x) 10)) lwx)) (setq dxf42l (vl-remove-if '(lambda ( x ) (/= (car x) 42)) lwx)) (while (< (setq k (1+ k)) (if (= 1 (logand 1 (cdr (assoc 70 lwx)))) (cdr (assoc 90 lwx)) (1- (cdr (assoc 90 lwx))))) (setq l (cons (list (nth k dxf10l) (nth k dxf42l)) l)) ) (setq l (reverse l)) (mapcar '(lambda ( a b ) (setq v1 (cdr (assoc 10 a)) v2 (cdr (assoc 10 b)) bul (cdr (assoc 42 a))) (if (not (equal bul 0.0 1e-6)) (progn (setq b->a (LM:Bulge->Arc v1 v2 bul)) (setq pl (cons (list (caar b->a) (+ (cadar b->a) (last b->a)) (cdr (assoc 38 lwx))) pl) pl (cons (list (caar b->a) (- (cadar b->a) (last b->a)) (cdr (assoc 38 lwx))) pl)) ) ) ) l (cdr l) ) (setq pl (mapcar '(lambda ( p ) (trans p lw 1)) pl)) (foreach p pl (if (not (equal p (osnap p "_nea") 1e-6)) (setq pl (vl-remove p pl)) ) ) (setq pl (vl-sort pl '(lambda ( a b ) (< (cadr (trans a 1 lw)) (cadr (trans b 1 lw)))))) (prompt "\nMinimum Y coordinate arced point in current UCS : ") (princ (car pl)) (prompt "\nMaximum Y coordinate arced point in current UCS : ") (princ (last pl)) (princ) ) This is all Vanilla AutoLisp, just in case VLISP functions not available...
    1 point
×
×
  • Create New...