Author Topic: findclosestpointtonestedinblkref.lsp - problem with xrefs  (Read 154 times)

0 Members and 1 Guest are viewing this topic.

ribarm

  • Water Moccasin
  • Posts: 2160
  • Marko Ribar, architect
findclosestpointtonestedinblkref.lsp - problem with xrefs
« on: November 08, 2019, 05:20:26 AM »
Hi guys...
I wrote a lisp inspired with this topic :
https://www.cadtutor.net/forum/topic/68947-how-to-get-block-nearest-end-point-or-perpendicular-point/

that works on complex block references that consist of curves, other blocks and other entities...
It works well with blocks, however, I wanted to use it also with xrefs and then boomer!!! It works, but results are sometimes with complex xrefs unexpected (wrong)... The problem IMHO lies in the fact that parent entity to nested xref is not block or xref it's nested to, but directly Model Space... Here I am posting my version for xrefs and blocks, but I have the one just for blocks that works - parent of nested block is always block... Also I am not sure if my sub for (collectingblkrefs) is doing good job as it's a little difficult to explain - it should collect all relevant parent entities to nested curve entity and only with this info, routine should process - finding closestpointto that nested curve...

In attached *.zip is my problem - there is folder with xrefs - main *.dwg is xrefs.dwg, and when you test it on simple xrefs also in main dwg it works, but when applied to complex one (1.dwg) that consists only of circle curves complexly nested in blocks and other xrefs it won't work as desired...

Please, take a look and if you find something relevant I should be using, please reply... I and others will be very grateful...
M.R.

Code - Auto/Visual Lisp: [Select]
  1. (defun c:findclosestpointtonestedinblkref ( / findclosestpointtonestedinblkref refgeom trp mxm mxv LM:InverseMatrix processclosestpointto processclosestpointtoinv collectblkrefs collectallentsfromref collectallcurvesnestedinblkrefwithparentrefassociations stblkref blkref wcspt p )
  2.  
  3.  
  4.   (defun findclosestpointtonestedinblkref ( blkref wcspt / pl curreflst rg )
  5.  
  6.     (vl-load-com)
  7.  
  8.     (foreach curref (setq curreflst (collectallcurvesnestedinblkrefwithparentrefassociations blkref))
  9.       (setq pl (cons (processclosestpointto (cadr curref) ((lambda ( matveclst ) (mapcar '+ (mxv (car matveclst) (vlax-curve-getclosestpointto (car curref) (processclosestpointtoinv (cadr curref) (mxv (LM:InverseMatrix (car (setq rg (refgeom (last (cadr curref)))))) (mapcar '- wcspt (cadr rg)))))) (cadr matveclst))) (refgeom (car (cadr curref))))) pl))
  10.     )
  11.     (car (vl-sort pl '(lambda ( a b ) (< (distance a wcspt) (distance b wcspt)))))
  12.   )
  13.  
  14.   ;; RefGeom (gile)
  15.   ;; Returns a list whose first item is a 3x3 transformation matrix and
  16.   ;; second item the object insertion point in its parent (xref, block or space)
  17.  
  18.   (defun refgeom ( ent / ang enx mat ocs )
  19.       (setq enx (entget ent)
  20.             ang (cdr (assoc 050 enx))
  21.             ocs (cdr (assoc 210 enx))
  22.       )
  23.       (list
  24.           (setq mat
  25.               (mxm
  26.                   (mapcar '(lambda ( v ) (trans v 0 ocs t))
  27.                      '(
  28.                           (1.0 0.0 0.0)
  29.                           (0.0 1.0 0.0)
  30.                           (0.0 0.0 1.0)
  31.                       )
  32.                   )
  33.                   (mxm
  34.                       (list
  35.                           (list (cos ang) (- (sin ang)) 0.0)
  36.                           (list (sin ang) (cos ang)     0.0)
  37.                          '(0.0 0.0 1.0)
  38.                       )
  39.                       (list
  40.                           (list (cdr (assoc 41 enx)) 0.0 0.0)
  41.                           (list 0.0 (cdr (assoc 42 enx)) 0.0)
  42.                           (list 0.0 0.0 (cdr (assoc 43 enx)))
  43.                       )
  44.                   )
  45.               )
  46.           )
  47.           (mapcar '- (trans (cdr (assoc 10 enx)) ocs 0)
  48.               (mxv mat (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 enx))))))
  49.           )
  50.       )
  51.   )
  52.  
  53.   ;; Matrix Transpose  -  Doug Wilson
  54.   ;; Args: m - nxn matrix
  55.  
  56.   (defun trp ( m )
  57.       (apply 'mapcar (cons 'list m))
  58.   )
  59.  
  60.   ;; Matrix x Matrix  -  Vladimir Nesterovsky
  61.   ;; Args: m,n - nxn matrices
  62.  
  63.   (defun mxm ( m n )
  64.       ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
  65.   )
  66.  
  67.   ;; Matrix x Vector  -  Vladimir Nesterovsky
  68.   ;; Args: m - nxn matrix, v - vector in R^n
  69.  
  70.   (defun mxv ( m v )
  71.       (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
  72.   )
  73.  
  74.   ;;--------------------=={ Inverse Matrix }==------------------;;
  75.   ;;                                                            ;;
  76.   ;;  Implements the Gauss-Jordan Elimination algorithm to      ;;
  77.   ;;  inverse a non-singular nxn matrix.                        ;;
  78.   ;;------------------------------------------------------------;;
  79.   ;;  Author: Lee Mac, Copyright 2011 - www.lee-mac.com       ;;
  80.   ;;------------------------------------------------------------;;
  81.   ;;  Arguments: m - nxn Matrix                                 ;;
  82.   ;;------------------------------------------------------------;;
  83.   ;;  Returns:  Matrix inverse, or nil if matrix is singular    ;;
  84.   ;;------------------------------------------------------------;;
  85.  
  86.   (defun LM:InverseMatrix ( m / _identity _eliminate p r x )
  87.  
  88.     (defun _identity ( n / i j l m ) (setq i 1)
  89.       (repeat n (setq j 0)
  90.         (repeat n
  91.           (setq l (cons (if (= i (setq j (1+ j))) 1. 0.) l))
  92.         )
  93.         (setq m (cons l m) l nil i (1+ i)) m
  94.       )
  95.     )
  96.  
  97.     (defun _eliminate ( m p )
  98.       (mapcar
  99.         (function
  100.           (lambda ( x / d )
  101.             (setq d (car x)) (mapcar (function (lambda ( a b ) (- a (* d b)))) (cdr x) p)
  102.           )
  103.         )
  104.         m
  105.       )
  106.     )
  107.     (setq m (mapcar 'append m (_identity (length m))))
  108.    
  109.     (while m
  110.       (setq p (apply 'max (mapcar 'abs (mapcar 'car m))))
  111.       (while (not (equal p (abs (caar m)) 1e-14))
  112.         (setq m (append (cdr m) (list (car m))))
  113.       )
  114.       (if (equal 0.0 (caar m) 1e-14)
  115.         (setq m nil)
  116.         (setq p (/ 1. (caar m))
  117.               p (mapcar (function (lambda ( x ) (* p x))) (cdar m))
  118.               m (_eliminate (cdr m) p)
  119.               r (cons p (_eliminate r p))
  120.         )
  121.       )
  122.     )
  123.     (reverse r)
  124.   )
  125.  
  126.   (defun processclosestpointto ( parentlst pt / parent )
  127.     (setq parentlst (cdr parentlst))
  128.     (if parentlst
  129.       (while (setq parent (car parentlst))
  130.         (setq pt ((lambda ( matveclst ) (mapcar '+ (mxv (car matveclst) pt) (cadr matveclst))) (refgeom parent)))
  131.         (setq parentlst (cdr parentlst))
  132.       )
  133.     )
  134.     pt
  135.   )
  136.  
  137.   (defun processclosestpointtoinv ( parentlst pt / child )
  138.     (setq parentlst (cdr (reverse parentlst)))
  139.     (if parentlst
  140.       (while (setq child (car parentlst))
  141.         (setq pt ((lambda ( matveclst ) (mxv (LM:InverseMatrix (car matveclst)) (mapcar '- pt (cadr matveclst)))) (refgeom child)))
  142.         (setq parentlst (cdr parentlst))
  143.       )
  144.     )
  145.     pt
  146.   )
  147.  
  148.   (defun collectblkrefs ( blkref curve / el ee )
  149.     (setq blkrefin (cons blkref blkrefin))
  150.     (if (null f)
  151.       (progn
  152.         (setq el (collectallentsfromref blkref))
  153.         (setq el (vl-sort el '(lambda ( a b ) (< (cdr (assoc 5 (entget a))) (cdr (assoc 5 (entget b)))))))
  154.       )
  155.     )
  156.     (vl-some '(lambda ( ee )
  157.       (cond
  158.         ( (wcmatch (cdr (assoc 0 (entget ee))) "*POLYLINE,SPLINE,XLINE,LINE,RAY,ARC,CIRCLE,ELLIPSE,HELIX")
  159.           (if (eq ee curve)
  160.             (progn
  161.               (setq blkrefinl blkrefin)
  162.               (setq f t)
  163.             )
  164.           )
  165.         )
  166.         ( (= (cdr (assoc 0 (entget ee))) "INSERT")
  167.           (collectblkrefs ee curve)
  168.           nil
  169.         )
  170.       )) el
  171.     )
  172.     blkrefinl
  173.   )
  174.  
  175.   (defun collectallentsfromref ( blkref / e el )
  176.  
  177.     (vl-load-com)
  178.  
  179.     (setq e (tblobjname "BLOCK" (vla-get-effectivename (vlax-ename->vla-object blkref))))
  180.     (while (setq e (entnext e))
  181.       (setq el (cons e el))
  182.     )
  183.     el
  184.   )
  185.  
  186.   (defun collectallcurvesnestedinblkrefwithparentrefassociations ( blkref / blkrefinl e el ex gg g q f )
  187.  
  188.     (vl-load-com)
  189.  
  190.     (if (null stblkref)
  191.       (setq stblkref blkref)
  192.     )
  193.     (setq el (collectallentsfromref blkref))
  194.     (setq el (vl-sort el '(lambda ( a b ) (< (cdr (assoc 5 (entget a))) (cdr (assoc 5 (entget b)))))))
  195.     (foreach e el
  196.       (setq ex (entget e))
  197.       (cond
  198.         ( (wcmatch (cdr (assoc 0 ex)) "*POLYLINE,SPLINE,XLINE,LINE,RAY,ARC,CIRCLE,ELLIPSE,HELIX")
  199.           (setq blkrefinl (collectblkrefs stblkref e))
  200.           (setq f nil)
  201.           (if (not (member blkref blkrefinl))
  202.             (setq blkrefinl (cons blkref blkrefinl))
  203.           )
  204.           (while (and blkrefinl (setq gg (cons (setq g (car (if (null f) (setq blkrefinl (member blkref blkrefinl)) blkrefinl))) gg)) (cadr blkrefinl))
  205.             (if (or f (vl-position e (collectallentsfromref g)))
  206.               (progn
  207.                 (setq q (vl-some '(lambda ( x ) (if (vl-position g (collectallentsfromref x)) x)) (vl-remove g blkrefinl)))
  208.                 (setq blkrefinl (member q blkrefinl))
  209.                 (setq f t)
  210.               )
  211.               (progn
  212.                 (setq gg (cdr gg))
  213.                 (setq blkrefinl (cdr blkrefinl))
  214.               )
  215.             )
  216.             (if (eq stblkref (car blkrefinl))
  217.               (setq blkrefinl (list (car blkrefinl)))
  218.             )
  219.           )
  220.           (setq curreflst (cons (list e (reverse gg)) curreflst))
  221.           (setq blkrefinl nil gg nil g nil q nil f nil)
  222.         )
  223.         ( (= (cdr (assoc 0 ex)) "INSERT")
  224.           (collectallcurvesnestedinblkrefwithparentrefassociations e)
  225.         )
  226.       )
  227.     )
  228.     curreflst
  229.   )
  230.  
  231.   (while
  232.     (or
  233.       (not (setq blkref (car (entsel "\nPick INSERT entity..."))))
  234.       (if blkref
  235.         (/= (cdr (assoc 0 (entget blkref))) "INSERT")
  236.       )
  237.     )
  238.     (prompt "\nMissed or picked wrong entity type...")
  239.     (textscr)
  240.   )
  241.   (initget 1)
  242.   (setq wcspt (trans (getpoint "\nPick or specify point : ") 1 0))
  243.   (princ (setq p (findclosestpointtonestedinblkref blkref wcspt)))
  244.   (entmake (list '(0 . "POINT") (cons 10 p)))
  245.   (princ)
  246. )
  247.  
« Last Edit: November 09, 2019, 04:35:32 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2160
  • Marko Ribar, architect
Re: findclosestpointtonestedinblkref.lsp - problem with xrefs
« Reply #1 on: November 08, 2019, 09:46:10 AM »
I've modified the code slightly to be somewhat better with xrefs, but still it doesn't find correct, but on the same looking nesting block near expecting one...
Also reattached *.zip with lisp mod...
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2160
  • Marko Ribar, architect
Re: findclosestpointtonestedinblkref.lsp - problem with xrefs
« Reply #2 on: November 08, 2019, 05:44:55 PM »
This is terribly slow and it will solve it correctly...

Code - Auto/Visual Lisp: [Select]
  1. (defun findclosestpointtonestedinblkref ( blkref wcspt / refgeom trp mxm mxv LM:InverseMatrix processclosestpointto processclosestpointtoinv collectblkrefs collectallentsfromref collectallcurvesnestedinblkrefwithparentrefassociations stblkref blkrefinl stblkrefrefel pl curreflst rg )
  2.  
  3.  
  4.   ;; RefGeom (gile)
  5.   ;; Returns a list whose first item is a 3x3 transformation matrix and
  6.   ;; second item the object insertion point in its parent (xref, block or space)
  7.  
  8.   (defun refgeom ( ent / ang enx mat ocs )
  9.       (setq enx (entget ent)
  10.             ang (cdr (assoc 050 enx))
  11.             ocs (cdr (assoc 210 enx))
  12.       )
  13.       (list
  14.           (setq mat
  15.               (mxm
  16.                   (mapcar '(lambda ( v ) (trans v 0 ocs t))
  17.                      '(
  18.                           (1.0 0.0 0.0)
  19.                           (0.0 1.0 0.0)
  20.                           (0.0 0.0 1.0)
  21.                       )
  22.                   )
  23.                   (mxm
  24.                       (list
  25.                           (list (cos ang) (- (sin ang)) 0.0)
  26.                           (list (sin ang) (cos ang)     0.0)
  27.                          '(0.0 0.0 1.0)
  28.                       )
  29.                       (list
  30.                           (list (cdr (assoc 41 enx)) 0.0 0.0)
  31.                           (list 0.0 (cdr (assoc 42 enx)) 0.0)
  32.                           (list 0.0 0.0 (cdr (assoc 43 enx)))
  33.                       )
  34.                   )
  35.               )
  36.           )
  37.           (mapcar '- (trans (cdr (assoc 10 enx)) ocs 0)
  38.               (mxv mat (cdr (assoc 10 (tblsearch "BLOCK" (cdr (assoc 2 enx))))))
  39.           )
  40.       )
  41.   )
  42.  
  43.   ;; Matrix Transpose  -  Doug Wilson
  44.   ;; Args: m - nxn matrix
  45.  
  46.   (defun trp ( m )
  47.       (apply 'mapcar (cons 'list m))
  48.   )
  49.  
  50.   ;; Matrix x Matrix  -  Vladimir Nesterovsky
  51.   ;; Args: m,n - nxn matrices
  52.  
  53.   (defun mxm ( m n )
  54.       ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
  55.   )
  56.  
  57.   ;; Matrix x Vector  -  Vladimir Nesterovsky
  58.   ;; Args: m - nxn matrix, v - vector in R^n
  59.  
  60.   (defun mxv ( m v )
  61.       (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
  62.   )
  63.  
  64.   ;;--------------------=={ Inverse Matrix }==------------------;;
  65.   ;;                                                            ;;
  66.   ;;  Implements the Gauss-Jordan Elimination algorithm to      ;;
  67.   ;;  inverse a non-singular nxn matrix.                        ;;
  68.   ;;------------------------------------------------------------;;
  69.   ;;  Author: Lee Mac, Copyright 2011 - www.lee-mac.com       ;;
  70.   ;;------------------------------------------------------------;;
  71.   ;;  Arguments: m - nxn Matrix                                 ;;
  72.   ;;------------------------------------------------------------;;
  73.   ;;  Returns:  Matrix inverse, or nil if matrix is singular    ;;
  74.   ;;------------------------------------------------------------;;
  75.  
  76.   (defun LM:InverseMatrix ( m / _identity _eliminate p r x )
  77.  
  78.     (defun _identity ( n / i j l m ) (setq i 1)
  79.       (repeat n (setq j 0)
  80.         (repeat n
  81.           (setq l (cons (if (= i (setq j (1+ j))) 1. 0.) l))
  82.         )
  83.         (setq m (cons l m) l nil i (1+ i)) m
  84.       )
  85.     )
  86.  
  87.     (defun _eliminate ( m p )
  88.       (mapcar
  89.         (function
  90.           (lambda ( x / d )
  91.             (setq d (car x)) (mapcar (function (lambda ( a b ) (- a (* d b)))) (cdr x) p)
  92.           )
  93.         )
  94.         m
  95.       )
  96.     )
  97.     (setq m (mapcar 'append m (_identity (length m))))
  98.    
  99.     (while m
  100.       (setq p (apply 'max (mapcar 'abs (mapcar 'car m))))
  101.       (while (not (equal p (abs (caar m)) 1e-14))
  102.         (setq m (append (cdr m) (list (car m))))
  103.       )
  104.       (if (equal 0.0 (caar m) 1e-14)
  105.         (setq m nil)
  106.         (setq p (/ 1. (caar m))
  107.               p (mapcar (function (lambda ( x ) (* p x))) (cdar m))
  108.               m (_eliminate (cdr m) p)
  109.               r (cons p (_eliminate r p))
  110.         )
  111.       )
  112.     )
  113.     (reverse r)
  114.   )
  115.  
  116.   (defun processclosestpointto ( parentlst pt / parent )
  117.     (setq parentlst (cdr parentlst))
  118.     (if parentlst
  119.       (while (setq parent (car parentlst))
  120.         (setq pt ((lambda ( matveclst ) (mapcar '+ (mxv (car matveclst) pt) (cadr matveclst))) (refgeom parent)))
  121.         (setq parentlst (cdr parentlst))
  122.       )
  123.     )
  124.     pt
  125.   )
  126.  
  127.   (defun processclosestpointtoinv ( parentlst pt / child )
  128.     (setq parentlst (cdr (reverse parentlst)))
  129.     (if parentlst
  130.       (while (setq child (car parentlst))
  131.         (setq pt ((lambda ( matveclst ) (mxv (LM:InverseMatrix (car matveclst)) (mapcar '- pt (cadr matveclst)))) (refgeom child)))
  132.         (setq parentlst (cdr parentlst))
  133.       )
  134.     )
  135.     pt
  136.   )
  137.  
  138.   (defun collectblkrefs ( blkref / el ee )
  139.     (setq blkrefinl (cons blkref blkrefinl))
  140.     (setq el (collectallentsfromref blkref))
  141.     (setq el (vl-sort el '(lambda ( a b ) (< (cdr (assoc 5 (entget a))) (cdr (assoc 5 (entget b)))))))
  142.     (foreach ee el
  143.       (if (= (cdr (assoc 0 (entget ee))) "INSERT")
  144.         (collectblkrefs ee)
  145.       )
  146.     )
  147.   )
  148.  
  149.   (defun collectallentsfromref ( blkref / e el )
  150.  
  151.     (vl-load-com)
  152.  
  153.     (setq e (tblobjname "BLOCK" (vla-get-effectivename (vlax-ename->vla-object blkref))))
  154.     (while (setq e (entnext e))
  155.       (setq el (cons e el))
  156.     )
  157.     el
  158.   )
  159.  
  160.   (defun collectallcurvesnestedinblkrefwithparentrefassociations ( blkref / unique e el ex gg ggl gggl ggx ggxl q qq ql f ff fff ffff )
  161.  
  162.     (vl-load-com)
  163.  
  164.     (defun unique ( l )
  165.       (if l (cons (car l) (unique (vl-remove-if '(lambda ( x ) (equal x (car l))) l))))
  166.     )
  167.  
  168.     (if (null stblkref)
  169.       (setq stblkref blkref)
  170.     )
  171.     (if (null blkrefinl)
  172.       (collectblkrefs stblkref)
  173.     )
  174.     (if (null stblkrefrefel)
  175.       (setq stblkrefrefel (vl-remove-if-not '(lambda ( x ) (= (cdr (assoc 0 (entget x))) "INSERT")) (collectallentsfromref stblkref)))
  176.     )
  177.     (setq el (collectallentsfromref blkref))
  178.     (setq el (vl-sort el '(lambda ( a b ) (< (cdr (assoc 5 (entget a))) (cdr (assoc 5 (entget b)))))))
  179.     (foreach e el
  180.       (setq ex (entget e))
  181.       (cond
  182.         ( (wcmatch (cdr (assoc 0 ex)) "*POLYLINE,SPLINE,XLINE,LINE,RAY,ARC,CIRCLE,ELLIPSE,HELIX")
  183.           (setq gg (cons (setq qq blkref) gg))
  184.           (if (not (eq qq stblkref))
  185.             (progn
  186.               (setq ggl (cons gg ggl))
  187.               (while (and ggl (not (vl-every '(lambda ( x ) (vl-position (car x) stblkrefrefel)) ggl)) (not (equal ggl gggl)))
  188.                 (setq gggl ggl)
  189.                 (if (null fff)
  190.                   (setq ggl nil)
  191.                 )
  192.                 (setq fff t)
  193.                 (foreach q (if ffff (mapcar 'car ggl) (list qq))
  194.                   (while (and (null ff) (setq ql (unique (vl-remove-if-not '(lambda ( x ) (vl-position q (collectallentsfromref x))) (vl-remove q blkrefinl)))) (if ggl (not (vl-every '(lambda ( x ) (vl-position (car x) stblkrefrefel)) ggl)) t))
  195.                     (if (null f)
  196.                       (foreach g ql
  197.                         (setq ggl (cons (cons g gg) ggl))
  198.                       )
  199.                       (progn
  200.                         (setq ggx (vl-remove-if-not '(lambda ( x ) (eq q (car x))) ggl))
  201.                         (setq ggl (vl-remove-if '(lambda ( x ) (vl-position x ggx)) ggl))
  202.                         (foreach xx ggx
  203.                           (setq ggx (mapcar '(lambda ( x ) (cons x xx)) ql))
  204.                           (setq ggxl (cons ggx ggxl))
  205.                         )
  206.                         (if ggxl
  207.                           (setq ggl (append (apply 'append ggxl) ggl))
  208.                         )
  209.                         (setq ggxl nil)
  210.                       )
  211.                     )
  212.                     (setq f t)
  213.                     (if (or (eq q qq) (eq q (cadar ggl)))
  214.                       (setq ff t)
  215.                       (setq ff nil)
  216.                     )
  217.                   )
  218.                   (setq ff nil ffff t)
  219.                   (setq ggl (unique ggl))
  220.                 )
  221.               )
  222.               (if (null ggl)
  223.                 (setq ggl (cons gg ggl))
  224.               )
  225.               (setq ggl (mapcar '(lambda ( x ) (cons stblkref x)) ggl))
  226.             )
  227.             (setq ggl (cons gg ggl))
  228.           )
  229.           (foreach gg ggl
  230.             (setq curreflst (cons (list e (reverse gg)) curreflst))
  231.           )
  232.           (setq gg nil ggl nil gggl nil ggx nil ggxl nil q nil qq nil ql nil f nil ff nil fff nil ffff nil)
  233.         )
  234.         ( (= (cdr (assoc 0 ex)) "INSERT")
  235.           (collectallcurvesnestedinblkrefwithparentrefassociations e)
  236.         )
  237.       )
  238.     )
  239.     curreflst
  240.   )
  241.  
  242.   (foreach curref (setq curreflst (collectallcurvesnestedinblkrefwithparentrefassociations blkref))
  243.     (setq pl (cons (processclosestpointto (cadr curref) ((lambda ( matveclst ) (mapcar '+ (mxv (car matveclst) (vlax-curve-getclosestpointto (car curref) (processclosestpointtoinv (cadr curref) (mxv (LM:InverseMatrix (car (setq rg (refgeom (last (cadr curref)))))) (mapcar '- wcspt (cadr rg)))))) (cadr matveclst))) (refgeom (car (cadr curref))))) pl))
  244.   )
  245.   (car (vl-sort pl '(lambda ( a b ) (< (distance a wcspt) (distance b wcspt)))))
  246. )
  247.  
  248. (defun c:findclosestpointtonestedinblkref ( / blkref wcspt p )
  249.   (while
  250.     (or
  251.       (not (setq blkref (car (entsel "\nPick INSERT entity..."))))
  252.       (if blkref
  253.         (/= (cdr (assoc 0 (entget blkref))) "INSERT")
  254.       )
  255.     )
  256.     (prompt "\nMissed or picked wrong entity type...")
  257.     (textscr)
  258.   )
  259.   (initget 1)
  260.   (setq wcspt (trans (getpoint "\nPick or specify point : ") 1 0))
  261.   (princ (setq p (findclosestpointtonestedinblkref blkref wcspt)))
  262.   (entmake (list '(0 . "POINT") (cons 10 p)))
  263.   (princ)
  264. )
  265.  

M.R.
« Last Edit: November 09, 2019, 05:49:53 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Water Moccasin
  • Posts: 2160
  • Marko Ribar, architect
Re: findclosestpointtonestedinblkref.lsp - problem with xrefs
« Reply #3 on: November 09, 2019, 02:53:33 AM »
I've updated my last post... Now it should find it correctly and for complex xrefs...
So this topic is SOLVED...

Thanks for attention,
M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube