TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: velasquez on December 14, 2016, 03:14:46 PM
-
I get a point on a line using (setq xpto (cadr (nentsel))) with (getvar "viewdir") = (-1.0 -1.0 1.0)
I need to calculate whether xpto is closest to DXF 10 or DXF 11 of this line.
Anyone already had to do this and can you help me?
Thanks
-
Simple example:
(and
(setq pick (nentsel "\nPick a line: "))
(= "LINE" (cdr (assoc 0 (setq enx (entget (car pick))))))
(if (apply '< (mapcar '(lambda (x) (distance (cadr pick) (cdr (assoc x enx)))) (list 10 11)))
(entmakex (list (cons 0 "POINT") (cons 62 1) (assoc 10 enx)))
(entmakex (list (cons 0 "POINT") (cons 62 1) (cons 10 (cdr (assoc 11 enx)))))
)
)
Well the worst scenario would be to pick a segment from a nested block.. maybe anyone else?
-
Simple example:
(and
(setq pick (nentsel "\nPick a line: "))
(= "LINE" (cdr (assoc 0 (setq enx (entget (car pick))))))
(if (apply '< (mapcar '(lambda (x) (distance (cadr pick) (cdr (assoc x enx)))) (list 10 11)))
(entmakex (list (cons 0 "POINT") (cons 62 1) (assoc 10 enx)))
(entmakex (list (cons 0 "POINT") (cons 62 1) (cons 10 (cdr (assoc 11 enx)))))
)
)
Well the worst scenario would be to pick a segment from a nested block.. maybe anyone else?
Its function always returns the same point.
I believe the problem is in transporting the point to the current plane but I could not.
Thanks
-
Should've included trans function, maybe attach sample drawing?
-
Should've included trans function, maybe attach sample drawing?
Follow the drawing.
Thanks for your help.
-
Ok, try:
(and
(setq pick (nentsel "\nPick a line: "))
(= "LINE" (cdr (assoc 0 (setq enx (entget (car pick))))))
(if (apply '< (mapcar '(lambda (x) (distance (osnap (cadr pick) "_NEA") (cdr (assoc x enx)))) (list 10 11)))
(entmakex (list (cons 0 "POINT") (cons 62 1) (assoc 10 enx)))
(entmakex (list (cons 0 "POINT") (cons 62 1) (cons 10 (cdr (assoc 11 enx)))))
)
)And a recently created, related thread (https://www.theswamp.org/index.php?topic=52380.0). :-D
-
Ok, try:
(and
(setq pick (nentsel "\nPick a line: "))
(= "LINE" (cdr (assoc 0 (setq enx (entget (car pick))))))
(if (apply '< (mapcar '(lambda (x) (distance (osnap (cadr pick) "_NEA") (cdr (assoc x enx)))) (list 10 11)))
(entmakex (list (cons 0 "POINT") (cons 62 1) (assoc 10 enx)))
(entmakex (list (cons 0 "POINT") (cons 62 1) (cons 10 (cdr (assoc 11 enx)))))
)
)And a recently created, related thread (https://www.theswamp.org/index.php?topic=52380.0). :-D
This worked well with the line.
I am now trying the same result with the selection on the block, without working with the line.
The reference points are the top and bottom center.
Thank you very much for your help.
-
I am now trying the same result with the selection on the block, without working with the line.
The reference points are the top and bottom center.
Thank you very much for your help.
The problem is that your block doesn't contain any lines, just the 3D Solid.
However it is possible to obtain these points, but the routine will work specifically for this particular block, Example:
(defun C:test ( / blk blkobj explosion TheSolid Lst pts)
(and
(setq blk (car (entsel "\nSelect the block: ")))
(setq blkobj (vlax-ename->vla-object blk))
(setq explosion (vlax-invoke blkobj 'Explode))
(vl-some (function (lambda (o) (and (eq (vla-get-ObjectName o) "AcDb3dSolid") (setq TheSolid o)))) explosion)
(not (command "_.EXPLODE" (setq TheSolid (vlax-vla-object->ename TheSolid))))
(setq Lst (GetEnamesFrom TheSolid))
(setq pts
(mapcar
(function
(lambda (o / ll ur)
(vla-GetBoundingBox o 'll 'ur)
(apply 'mapcar (cons '(lambda (a b) (/ (+ a b) 2.)) (mapcar 'vlax-safearray->list (list ll ur))))
)
)
(mapcar 'vlax-ename->vla-object (vl-remove-if-not (function (lambda (x) (= "REGION" (cdr (assoc 0 (entget x)))))) Lst))
)
)
(mapcar 'entdel Lst)
); and
(and pts (= 2 (length pts)) (apply 'grdraw (append pts (list 1 7))))
)
(defun GetEnamesFrom ( e / next Lst )
(if (setq next (entnext e))
(while next
(setq Lst (cons next Lst))
(setq next (entnext next))
)
)
Lst
)
In other words the above checks for the first occurence of a 3D Solid object, after exploding the block, then it explodes that same solid and looks for REGION objects.
After exploding the solid, both region objects are occuring at the top and bottom of the block, and just extract their boundingbox centroids, that are the desired points.
And at the end just erase all the created entities after exploding that block.
-
I am now trying the same result with the selection on the block, without working with the line.
The reference points are the top and bottom center.
Thank you very much for your help.
The problem is that your block doesn't contain any lines, just the 3D Solid.
However it is possible to obtain these points, but the routine will work specifically for this particular block, Example:
(defun C:test ( / blk blkobj explosion TheSolid Lst pts)
(and
(setq blk (car (entsel "\nSelect the block: ")))
(setq blkobj (vlax-ename->vla-object blk))
(setq explosion (vlax-invoke blkobj 'Explode))
(vl-some (function (lambda (o) (and (eq (vla-get-ObjectName o) "AcDb3dSolid") (setq TheSolid o)))) explosion)
(not (command "_.EXPLODE" (setq TheSolid (vlax-vla-object->ename TheSolid))))
(setq Lst (GetEnamesFrom TheSolid))
(setq pts
(mapcar
(function
(lambda (o / ll ur)
(vla-GetBoundingBox o 'll 'ur)
(apply 'mapcar (cons '(lambda (a b) (/ (+ a b) 2.)) (mapcar 'vlax-safearray->list (list ll ur))))
)
)
(mapcar 'vlax-ename->vla-object (vl-remove-if-not (function (lambda (x) (= "REGION" (cdr (assoc 0 (entget x)))))) Lst))
)
)
(mapcar 'entdel Lst)
); and
(and pts (= 2 (length pts)) (apply 'grdraw (append pts (list 1 7))))
)
(defun GetEnamesFrom ( e / next Lst )
(if (setq next (entnext e))
(while next
(setq Lst (cons next Lst))
(setq next (entnext next))
)
)
Lst
)
In other words the above checks for the first occurence of a 3D Solid object, after exploding the block, then it explodes that same solid and looks for REGION objects.
After exploding the solid, both region objects are occuring at the top and bottom of the block, and just extract their boundingbox centroids, that are the desired points.
And at the end just erase all the created entities after exploding that block.
Hello Grrr1337,
Excellent job.
I was able to solve the problem with the list of points.
I include the values with xdata in block creation.
But the problem is still carrying the selection point exactly up the entity and then checking the distance with the points in the list.
I tried with the trans function and excellent Lee Mac code to work with the matrix, but I did not get it.
-
If you're now getting the correct point, maybe you could use vlax-curve-getparamatpoint & check which one you're closest to ?
-
But the problem is still carrying the selection point exactly up the entity and then checking the distance with the points in the list.
I tried with the trans function and excellent Lee Mac code to work with the matrix, but I did not get it.
I thought you want to obtain the nearest picked to. The issue is that (cadr pick) always get Z=0, so (trans (cadr pick) (car pick) 0) seems to slove that problem (still has high failure chance):
(http://gifyu.com/images/Column.gif)
(defun C:test ( / pick blk blkobj explosion TheSolid Lst pts ClosestPoint )
(and
(setq pick (entsel "\nSelect the block: "))
(setq blk (car pick))
(setq blkobj (vlax-ename->vla-object blk))
(setq explosion (vlax-invoke blkobj 'Explode))
(vl-some (function (lambda (o) (and (eq (vla-get-ObjectName o) "AcDb3dSolid") (setq TheSolid o)))) explosion)
(not (command "_.EXPLODE" (setq TheSolid (vlax-vla-object->ename TheSolid))))
(setq Lst (GetEnamesFrom TheSolid))
(setq pts
(mapcar
(function
(lambda (o / ll ur)
(vla-GetBoundingBox o 'll 'ur)
(apply 'mapcar (cons (function (lambda (a b) (/ (+ a b) 2.))) (mapcar 'vlax-safearray->list (list ll ur))))
)
)
(mapcar 'vlax-ename->vla-object (vl-remove-if-not (function (lambda (x) (= "REGION" (cdr (assoc 0 (entget x)))))) Lst))
)
)
(mapcar 'entdel Lst)
); and
(and pts (= 2 (length pts))
(not (apply 'grdraw (append pts (list 1 7))))
(setq ClosestPoint
(cadar
(vl-sort
(mapcar 'list
(mapcar 'distance (mapcar (function (lambda (x) (trans (cadr x) (car x) 0))) (list pick pick)) (mapcar (function (lambda (x) (trans x 1 0))) pts))
pts
)
(function (lambda (a b) (< (car a) (car b))))
)
)
)
(entmakex (list (cons 0 "POINT") (cons 62 1) (cons 10 ClosestPoint)))
); and
)
(defun GetEnamesFrom ( e / next Lst )
(if (setq next (entnext e))
(while next
(setq Lst (cons next Lst))
(setq next (entnext next))
)
)
Lst
)
If you always want to obtain the top point, which is the block's basepoint, just use (cdr (assoc 10 (entget blk))). Not sure whats your end goal.
Maybe someone else could help.
If you're now getting the correct point, maybe you could use vlax-curve-getparamatpoint & check which one you're closest to ?
Problem is that there are no curves involved, only "REGION", "SURFACE", "3DSOLID" and "INSERT" entities.
-
From the first post in this thread I assumed it was a LINE :)
I get a point on a line using (setq xpto (cadr (nentsel))) with (getvar "viewdir") = (-1.0 -1.0 1.0)
..
-
From the first post in this thread I assumed it was a LINE :)
I get a point on a line using (setq xpto (cadr (nentsel))) with (getvar "viewdir") = (-1.0 -1.0 1.0)
..
My English is not good.
I used the line to demonstrate what I need.
Thanks
-
But the problem is still carrying the selection point exactly up the entity and then checking the distance with the points in the list.
I tried with the trans function and excellent Lee Mac code to work with the matrix, but I did not get it.
I thought you want to obtain the nearest picked to. The issue is that (cadr pick) always get Z=0, so (trans (cadr pick) (car pick) 0) seems to slove that problem (still has high failure chance):
(http://gifyu.com/images/Column.gif)
(defun C:test ( / pick blk blkobj explosion TheSolid Lst pts ClosestPoint )
(and
(setq pick (entsel "\nSelect the block: "))
(setq blk (car pick))
(setq blkobj (vlax-ename->vla-object blk))
(setq explosion (vlax-invoke blkobj 'Explode))
(vl-some (function (lambda (o) (and (eq (vla-get-ObjectName o) "AcDb3dSolid") (setq TheSolid o)))) explosion)
(not (command "_.EXPLODE" (setq TheSolid (vlax-vla-object->ename TheSolid))))
(setq Lst (GetEnamesFrom TheSolid))
(setq pts
(mapcar
(function
(lambda (o / ll ur)
(vla-GetBoundingBox o 'll 'ur)
(apply 'mapcar (cons (function (lambda (a b) (/ (+ a b) 2.))) (mapcar 'vlax-safearray->list (list ll ur))))
)
)
(mapcar 'vlax-ename->vla-object (vl-remove-if-not (function (lambda (x) (= "REGION" (cdr (assoc 0 (entget x)))))) Lst))
)
)
(mapcar 'entdel Lst)
); and
(and pts (= 2 (length pts))
(not (apply 'grdraw (append pts (list 1 7))))
(setq ClosestPoint
(cadar
(vl-sort
(mapcar 'list
(mapcar 'distance (mapcar (function (lambda (x) (trans (cadr x) (car x) 0))) (list pick pick)) (mapcar (function (lambda (x) (trans x 1 0))) pts))
pts
)
(function (lambda (a b) (< (car a) (car b))))
)
)
)
(entmakex (list (cons 0 "POINT") (cons 62 1) (cons 10 ClosestPoint)))
); and
)
(defun GetEnamesFrom ( e / next Lst )
(if (setq next (entnext e))
(while next
(setq Lst (cons next Lst))
(setq next (entnext next))
)
)
Lst
)
If you always want to obtain the top point, which is the block's basepoint, just use (cdr (assoc 10 (entget blk))). Not sure whats your end goal.
Maybe someone else could help.
If you're now getting the correct point, maybe you could use vlax-curve-getparamatpoint & check which one you're closest to ?
Problem is that there are no curves involved, only "REGION", "SURFACE", "3DSOLID" and "INSERT" entities.
Your picture shows the work.
My final goal is to work with the selection point to calculate the distance between it and the ends of the block.
-
But the problem is still carrying the selection point exactly up the entity and then checking the distance with the points in the list.
I tried with the trans function and excellent Lee Mac code to work with the matrix, but I did not get it.
I thought you want to obtain the nearest picked to. The issue is that (cadr pick) always get Z=0, so (trans (cadr pick) (car pick) 0) seems to slove that problem (still has high failure chance):
In my drawing if the block is moved the code always returns the lower point of the block.
-
Your picture shows the work.
My final goal is to work with the selection point to calculate the distance between it and the ends of the block.
IMO alot more efficient would be if you include that axis line into the block's definition, so we could skip all the nasty explode stuff.
And this one should give you everything you need, both distances and the coordinates of the closest point:
(defun C:test ( / p pick e enx BothDistances ClosestPoint)
(while
(not
(and
(setq p (getpoint "\nSelect the line: "))
(setq pick (nentselp p))
(setq e (car pick))
(= "LINE" (cdr (assoc 0 (setq enx (entget e)))))
(if (apply '< (setq BothDistances (mapcar '(lambda (x) (distance p (cdr (assoc x enx)))) (list 10 11))))
(setq ClosestPoint (cdr (assoc 10 enx)))
(setq ClosestPoint (cdr (assoc 11 enx)))
)
)
)
p
)
(alert
(strcat
"\nFirst distance: " (rtos (car BothDistances) 2) " units."
"\nSecond Distance: " (rtos (cadr BothDistances) 2) " units."
"\nClosest Point is located at: " (vl-princ-to-string ClosestPoint) " coordinates."
)
)
(princ)
)
Although it was an interesting practice! :-D
-
Your picture shows the work.
My final goal is to work with the selection point to calculate the distance between it and the ends of the block.
IMO alot more efficient would be if you include that axis line into the block's definition, so we could skip all the nasty explode stuff.
And this one should give you everything you need, both distances and the coordinates of the closest point:
Although it was an interesting practice! :-D
The image shows how my work is.
The selection point obtained with (cadr (nentsel) is used in the left block without problem.
Note that in the right block the calculation fails, always returning the same coordinate.
-
I don't think you'll have this problem with the last code I posted, the only requirement is to include that line into the block's definition.
-
Here is my snippet, but I haven't read whole topic deeply, so this is only applicable for picking curves such as LINE among others...
(defun c:test
( / s l p
)
(prompt "\nPicked point is closer to end point of curve...") (prompt "\nPicked point is closer to start point of curve...") )
)
)
Regards...
-
@Marko:
I think the viewdir is expressed in the current UCS.
So you should use:
(trans (getvar 'viewdir) 1 0 T)
-
@Marko:
I think the viewdir is expressed in the current UCS.
So you should use:
(trans (getvar 'viewdir) 1 0 T)
Yes, Roy, you're right... Thanks for heads up... I've corrected my library in all occurs of this mistake... I simply haven't checked it in random UCS...
Many thanks... M.R.
-
I appreciate the help I'm getting.