Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Align Block problem

9 REPLIES 9
Reply
Message 1 of 10
rajeshpatnaik2001
1257 Views, 9 Replies

Align Block problem

Hello,

 

I am trying to write a program to align a block with two selected destination points. 
- first the user is prompted to select a lwpolyline of a block entity
- then he is prompted to pick two destination points

I face problem with the sub-routine SegmentPts. It is supposed to return the coordinates of two vertexes on both sides of the picked point on a lwpolyline using entsel. But here in my program, when i am picking a point using entsel on a lwpolyline inside a block entity, it is not returning the two vertexes on both sides of the picked point. In stead, it returns some other points of the selected LWPOLYLINE. Why it is doing so? Where is the problem in my program?

It works fine with my other programs where i pick on a LWPOLYLINE entity.
In this particular case, the LWPOLYLINE is inside a Block entity and the program is not returning correct points.

Any help in thisregard will be highly appreciated.

 

Thanks

 

Please check my my Lisp Program below:

 

(defun C:alb()
(setq ent1 (entsel "\nPick on one side of LWLINE ofa Block:" ))
(setq ent (nentselp (cadr ent1)))
(setq ins_pt (cdr (assoc 10 (entget (car ent1)))))
(setq pt_d1 (getpoint "\nSpecify first destination point:"))
(setq pt_d2 (getpoint "\nSpecify Second destination point:" pt_d1))
(setq pt_l (SegmentPts ent))
(setq pt_a (car pt_l) pt_b (cadr pt_l))
(command "align" (car ent1) "" (setq a (translate pt_a ins_pt)) pt_d1 (setq b (translate pt_b ins_pt)) pt_d2 "" "N")
)

;;;;;;;;;;;;;;;;;;;;;;;
(defun translate (pt pin /)
(mapcar '+ pt pin)
)

 ;;;;;;;;;;;;;;;;;;;;;;;


(defun SegmentPts (ent / e pnt vobj Name param1 param2 p1 p2 SegPts)
(vl-load-com)
(and
(setq e (car ent))
(= (type e) 'ENAME)
(setq pnt (cadr ent))
(listp pnt)
(not (atom (cdr pnt)))
(vl-every (function (lambda (x) (= (type x) 'REAL))) pnt)
(setq vobj (vlax-ename->vla-object (car ent)))
(setq pnt (trans (cadr ent) 1 0))
(setq pnt (vlax-curve-getClosestPointTo vobj pnt))
(setq Name (vla-get-ObjectName vobj))
(cond
((vl-position Name '("AcDbArc" "AcDbLine"))
(setq p1 (vlax-curve-getStartPoint vobj))
(setq p2 (vlax-curve-getEndPoint vobj))
)
((wcmatch (strcase Name) "*POLYLINE")
(setq param1 (vlax-curve-getParamAtPoint vobj pnt))
(setq param1 (fix param1))
(setq param2 (1+ param1))
(if (equal param1 (vlax-curve-getStartParam vobj) 1e-10)
(setq p1 (vlax-curve-getStartPoint vobj))
(setq p1 (vlax-curve-getPointAtParam vobj param1))
)
(if (equal param2 (vlax-curve-getEndParam vobj) 1e-10)
(setq p2 (vlax-curve-getEndPoint vobj))
(setq p2 (vlax-curve-getPointAtParam vobj param2))
)
) ;pline cond
(T
(prompt (strcat "\nHaven't figured out a(n) " Name " yet."))
)
) ;conditions
p1
p2
(setq SegPts (list p1 p2))
) ;and
SegPts
) ;end



 

9 REPLIES 9
Message 2 of 10


@rajeshpatnaik2001 wrote:

..... It is supposed to return the coordinates of two vertexes on both sides of the picked point on a lwpolyline using entsel. But here in my program, when i am picking a point using entsel on a lwpolyline inside a block entity, it is not returning the two vertexes on both sides of the picked point. In stead, it returns some other points of the selected LWPOLYLINE. Why it is doing so? Where is the problem in my program?
....


The problem is that the definition points of objects in Blocks are stored in relationship to the Block's definition.  For example, a Line endpoint or a Polyline vertex that is at the Block's insertion point will be "defined" in the nested object's entity data list as being at 0,0,0, no matter where the Block is inserted or at what scale(s) or rotation.  Try it on a Block inserted at 0,0, with a scale of 1 and rotation of 0, and I think the correct points will be returned.

 

I think you will need to convert the location using (trans) from the Block's coordinates to current coordinates, but quickie experiments are not giving me the result I expected.  I will look at it again later, unless someone else pipes in, or you may find a solution with a Search.

Kent Cooper, AIA
Message 3 of 10

Thanks for your reply.


Yes, the definition points of objects are stored in relationship to the block's definition.
In my program, I use the sub-routine translate to get the actual coordinate at block insertion. Even when i run the program, I get the actual coordinate of two vertex coordinates of the LWPOLYLINE at block insertion, but not the two vertex coordinates (both end vertex of the segment of the LWPOLYLINE on which the user picked), which the sub-routine segmentpts is supposed to return!

When in the routine, i explode the block and capture the vertex coordinates using the sub-routine segmentpts, it works perfectly.
I modified the routine to capture the vertex coordinates after exploding as follows. It works perfectly. I wonder why the sub-routine is returing the wrong vertex coordinates  when the LWPOLYLINE is inside the block!

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 

(defun C:alb()
(setq ent1 (entsel "\nPick on one side of LWPOLYLINE of a Block:" ))
(setq pt (cadr ent1))
(command "undo" "mark")
(command "explode" (car ent1))
(setq ent (nentselp pt))
(setq pt_l (SegmentPts ent))
(setq pt_a (car pt_l))
(setq pt_b (cadr pt_l))
(command "undo" "back")
(setq pt_d1 (getpoint "\nSpecify first destination point:"))
(setq pt_d2 (getpoint "\nSpecify Second destination point:" pt_d1))
(command "align" (car ent1) "" pt_a pt_d1 pt_b pt_d2 "" "N")
)

Message 4 of 10
pbejse
in reply to: rajeshpatnaik2001

Try this

 

(defun C:alb (/ _temppl ent1 ent pt_d1 pt_d2 pts tml ptrf)
  ;;	pBe 14May2013	;;;
  (vl-load-com)
  (defun _temppl (ne / tmp)
    (setq tmp (entmakex (entget (car ne))))
    (vla-transformby (vlax-ename->vla-object tmp) (vlax-tmatrix (caddr ne)))
    tmp
  )
  (if (and
        (setq ent1 (entsel "\nPick on one side of LWLINE ofa Block:"))
        (setq ent (nentselp (cadr ent1)))
        (setq pt_d1 (getpoint "\nSpecify first destination point:"))
        (setq pt_d2 (getpoint "\nSpecify Second destination point:" pt_d1))
      )
    (progn
      (setq tml (_temppl ent))
      (setq pts (mapcar 'cdr
                        (vl-remove-if-not
                          '(lambda (j)
                             (= (car j) 10)
                           )
                          (entget tml)
                        )
                )
      )
      (setq ptrf (vlax-curve-getClosestPointTo tml (cadr ent1)))
      (Setq pts
             (if (< (distance (Car pts) ptrf)
                    (distance (last pts) ptrf)
                 )
               pts
               (reverse pts)
             )
      )
      (entdel tml)
      (command "align"  (car ent1)
               ""  "_non" (Car pts)
               "_non"  pt_d1
               "_non" (last pts)
               "_non"  pt_d2
               "" "N"
      )
    )
  )
  (princ)
)

 HTH

Message 5 of 10
hmsilva
in reply to: pbejse

pBe,
not quite... Smiley Wink

the problem is that we must provide the pick point in OCs, and it cames in WCS or in UCS, so we need to provide to the code a point in the OCS, to calculate the "Param At Point"...
This code is just a demo, and serves to demonstrate one way to achieve the required result, but it require additional testing to determine the OCS position of each point, to ensure that the final result of Align command, is the desired one, because it is influenced by the LwPolyline direction...
With the aid of functions from Doug Wilson, Vladimir Nesterovsky and Gilles Chanteau, maybe something like this

 

(defun c:test (/ ENT EPT PARM1 PT1 PTA PTF PTINS PTS SEL SPT)
  (vl-load-com)
;; RCS2WCS (gile)
;; Translates coordinates from Reference (block or xref) Coordinate System to WCS
;; Arguments :
;; pt : a point in RCS, got by (cdr (assoc 10 (entget (car (nentsel))))) i.e.
;; mat : a transformation matrix as those returned either by (caddr (nentsel)) or (caddr (nentselp))
(defun RCS2WCS (pt mat)
  (if (= 3 (length (car mat)))
    (mapcar '+ (mxv (trp (butlast mat)) pt) (last mat))
    (mapcar '+
	    (mxv (mapcar 'butlast (butlast mat)) pt)
	    (butlast (mapcar 'last mat))
    )
  )
);; RCS2WCS
;;; VXV Returns the dot product of 2 vectors
(defun vxv (v1 v2) (apply '+ (mapcar '* v1 v2)))
;; TRP Transpose a matrix -Doug Wilson-
(defun trp (m) (apply 'mapcar (cons 'list m)))
;; MXV Apply a transformation matrix to a vector -Vladimir Nesterovsky-
(defun mxv (m v) (mapcar '(lambda (r) (vxv r v)) m))
;; BUTLAST Returns a list but last item
(defun butlast (l) (reverse (cdr (reverse l))))
;; WCS2RCS (gile)
;; Translates coordinates from WCS to Reference (block or xref) Coordinate System
;; pt : a point in WCS
;; mat : a transformation matrix as those returned either by (caddr (nentsel)) or (caddr (nentselp))
(defun WCS2RCS (pt mat)
  (setq pt (trans pt 0 0))
  (if (= 3 (length (car mat)))
    (setq mat (append (trp mat) (list '(0.0 0.0 0.0 1.0))))
  )
  (setq mat (InverseMatrix mat))
  (mapcar '+ (mxv mat pt) (butlast (mapcar 'last mat)))
);; WCS2RCS
;; InverseMatrix (gile) 2009/03/17
;; Uses the Gauss-Jordan elimination method to calculate the inverse
;; matrix of any dimension square matrix
;;
;; Argument : a square matrix
;; Return : the inverse matrix (or nil if singular)
(defun InverseMatrix (mat / col piv row res)
  (setq	mat (mapcar '(lambda (x1 x2) (append x1 x2)) mat (Imat (length mat))))
  (while mat
    (setq col (mapcar '(lambda (x) (abs (car x))) mat))
    (repeat (vl-position (apply 'max col) col)
      (setq mat (append (cdr mat) (list (car mat))))
    )
    (if	(equal (setq piv (caar mat)) 0.0 1e-14)
      (setq mat	nil
	    res	nil
      )
      (setq piv	(/ 1.0 piv)
	    row	(mapcar '(lambda (x) (* x piv)) (car mat))
	    mat	(mapcar
		  '(lambda (r / e)
		     (setq e (car r))
		     (cdr (mapcar '(lambda (x n) (- x (* n e))) r row))
		   )
		  (cdr mat)
		)
	    res	(cons
		  (cdr row)
		  (mapcar
		    '(lambda (r / e)
		       (setq e (car r))
		       (cdr (mapcar '(lambda (x n) (- x (* n e))) r row))
		     )
		    res
		  )
		)
      )
    )
  )
  (reverse res)
);; InverseMatrix
;; IMAT (gile)
;; Returns the specified dimension identity matrix
;;
;; Argument
;; d : the matrix dimension (positive integer)
(defun Imat (d / i n r m)
  (setq i d)
  (while (<= 0 (setq i (1- i)))
    (setq n d r nil)
    (while (<= 0 (setq n (1- n)))
      (setq r (cons (if (= i n) 1.0 0.0) r))
    )
    (setq m (cons r m))
  )
);; Imat
  
  (if (and (setq sel (nentsel "\nSelect LwPolyline segment in a Block to Align: "))
	   (= (cdr (assoc 0 (entget (car sel)))) "LWPOLYLINE")
	   (setq ptf (getpoint "\nSpecify first destination point: "))
           (setq pts (getpoint "\nSpecify second destination point: " ptf))
	   );; and
    (progn
  (setq	pt1   (osnap (cadr sel) "nea")
	ent   (car sel)
	ptins (cdr (assoc 10 (entget (car (cadddr sel)))))
	pt1   (vlax-curve-getClosestPointTo ent (WCS2RCS pt1 (caddr sel)))
	parm1 (fix (vlax-curve-getParamAtPoint ent pt1))
	spt   (RCS2WCS (vlax-curve-getPointAtParam ent parm1) (caddr sel))
	ept   (RCS2WCS (vlax-curve-getPointAtParam ent (1+ parm1)) (caddr sel))
  );; setq
(command "._align"  (car (cadddr sel)) ""  "_non" spt "_non" ptf "_non" ept "_non"  pts "" "N")
);; progn
    );; if
);; test

hope that helps
Henrique

EESignature

Message 6 of 10


@rajeshpatnaik2001 wrote:

.... 

I am trying to write a program to align a block with two selected destination points. 
- first the user is prompted to select a lwpolyline of a block entity
- then he is prompted to pick two destination points
....


Here's a different approach you might try.  Since, in the case of a Line, you don't necessarily know which end is which, or in the case of a Polyline line segment, you don't necessarily know in which direction the Polyline was drawn, then even if it works as expected, you're taking your chances on the location and direction of the Block after it is aligned, and you may need to rotate it 180 degrees and/or move it afterwards for the intended final result.  Given that, you can do this a lot more simply for straight elements by just using object snap to find the nearest endpoint and the nearest point to the pick point, and they will give you alignment points.

 

This approach would not work right in the case of the Arc possibility in your SegmentPts function, but it works for any Osnappable straight entity or portion thereof with an end in your Block -- Line, Polyline line segment, Mline, Trace, Ray, Hatch pattern, edge of 2D Solid or 3Dface or Tolerance box or Wipeout or Image, straight-format Leader, straight edge of Region or 3D Solid, extension line of any Dimension, dimension line of any linear variety of Dimension, even an edge of a Dimension arrowhead, etc. -- and there would be no need even to determine what the entity type is, if you can trust the User not to pick on something inappropriate.  And it returns points in current coordinates, so no translation is necessary, which is the main reason it can be so short.

 

(defun C:alb (/ esel pt_a pt_b pt_d1 pt_d2)
  (setq

    esel (entsel "\nPick on any straight element in a Block by which to align it: ")

    pt_a (osnap (cadr esel) "_end")

    pt_b (osnap (cadr esel) "_nea")
    pt_d1 (getpoint "\nSpecify first destination point: ")
    pt_d2 (getpoint pt_d1 "\nSpecify second destination point: ")

  ); setq
  (command "align" (car esel) "" pt_a pt_d1 pt_b pt_d2 "" "N")
)

 

In fact, that also works on any straight entity or portion thereof, even if not nested in a Block -- no need to have separate routines for nested or non-nested things.  You could therefore change the command name and the prompt.

 

If you want to make it more foolproof, you could add a check on whether what was selected is, in fact, a straight element with an end [e.g. not an Xline, Circle, Arc, Text, etc., or if a Polyline, not a fit-curved or splined one or on an arc segment, or if a Leader, not a spline-format one] -- I have code to do that in a routine that does something else, if you're interested.

 

If you need the possibility of Arcs or Polyline arc segments, it would need to be more sophisticated to find the appropriate endpoints or adjacent vertices, including the translation complications, because the point nearest the pick point would be irrelevant.  But I'm having a hard time imagining a situation in which you would want to align the ends of a Polyline arc segment in a Block with something.

 

It probably ought to turn off running object snap, too, and if it does, have an error handler to ensure resetting it.

Kent Cooper, AIA
Message 7 of 10
stevor
in reply to: Kent1Cooper

And perhaps even XLINEs could be used, with the addition of the code to use osnap NEAR.
S
Message 8 of 10
Kent1Cooper
in reply to: stevor


@stevor wrote:
And perhaps even XLINEs could be used, with the addition of the code to use osnap NEAR.

Yes, except that the NEArest object snap is already being used.  In the other routine I have that does entity-type and straightness checking, if the object [or nested object] is an Xline, it uses Osnap NEArest and MIDpoint to determine the direction the Xline runs, instead of NEArest and ENDpoint as it does for various other things.  [There is the very slight risk that if you happen to select it exactly at its definition/origin point (which is considered its Midpoint in object-snap terms), it will get the same location for both results.]

 

However, under the circumstances of this thread, it may not matter.  I've never included an Xline in a Block, and though it is allowable, I'm wondering what reason one might have to do that.  But for the non-nested usage, it seems at least more likely to be something that should be accounted for, and could be easily enough with the same kind of checking.

Kent Cooper, AIA
Message 9 of 10

Thanks Kent1Cooper! Your short program is working fine. It is not working fine only when there is some other nearer end point than the end point of the selected segment.

I will test the other routines posted by pbejse and hmsilva later today and i will try to find out the problem in my first posted routine.

 

Thank you all ! 🙂

 

Rajesh

Message 10 of 10


@rajeshpatnaik2001 wrote:

Thanks Kent1Cooper! Your short program is working fine. It is not working fine only when there is some other nearer end point than the end point of the selected segment.
....


A simple way to prevent that:  add this before the (setq) function:

 

  (setvar 'aperture (getvar 'pickbox))

 

That will make the object-snap aperture window the same size as the selection picking box size, so that [since you won't pick something where it meets something else] object snap will look for the appropriate location only on the selected object.

 

Of course, you should also save the starting APERTURE System Variable value into a variable first, and reset it afterwards.

Kent Cooper, AIA

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost