Moving obect but inconsistance destination point

[Pradeep Kumar]

I'm new to Autolisp please forgive me for my bad coding. I'm trying to find the coverage area by copying and moving the closed polyline (in "_ResiFSI" layer) but due to some unknown reason I couldn't move the object precisely to the destination that I have picked using "getpoint". There is reference block named "Direction Ref Point" in each floor plan (floor plan is drafted in "_Floor" layer) and when I try to copy each closed polyline in "_ResiFSI" with based point as reference blocks location and destination point from user input. Please help me.

Note: I have also tried to regenerate the views and also used zoom extent. Please find the drawing in attachment.

(defun c:ca()

(setq ctr1 0 chk 0)
(setq fpt (getpoint))
(command "ZOOM" "E")
(setq sset1 (ssget "x" '((0 . "LWPOLYLINE")(8 . "_Floor")) ))
(repeat (sslength sset1)
	(setq ctr 0)
 		(SETQ PEN (ssname sset1 ctr1))

 		(SETQ PENL (ENTGET PEN))
 		(SETQ PPL (LIST))
 	(FOREACH N PENL
 		(PROGN
   		(SETQ PPA (CAR N))
   		(SETQ PPV (CDR N))
   		(IF (= PPA 10) (SETQ PPL (APPEND PPL (LIST PPV))))
 	));END N

	(setq sset (ssget "WP" PPL   ))
	(command "ZOOM" "E")
	(repeat (sslength sset)
	
		(setq item (ssname sset ctr))
		(setq item (vlax-ename->vla-object item))
		(setq layrname (vla-get-layer item))
	
	(setq tst (cdr (assoc 0 (entget (ssname sset ctr)))) )
	(if (= tst "LWPOLYLINE") (cond ((= layrname "_ResiFSI") (setq copyitem (ssname sset ctr)) 
	(setq chk 1)
	));cond
	);if
	(cond ((= layrname "_Floor")
		(cond ( (= tst "INSERT") 
			(setq blockname (cdr (assoc 2 (entget (ssname sset ctr)))))
		))
		)
	)
			(cond ((= "Direction Ref Point" blockname)
				(setq bpt (cdr (assoc 10 (entget (ssname sset ctr)))))
			))
	
		(setq ctr (1+ ctr))

	);repeat for block

	(if (= chk 1) (PK:mycopy copyitem bpt fpt))
	(setq chk 0)
	(setq ctr1 (+ ctr1 1))

	);repeat for floor

);defun

(defun PK:mycopy(obj pt1 pt2)
(setq thisdrawing 
       (vla-get-activedocument 
               (vlax-get-acad-object)))

	(vla-Regen thisdrawing acActiveViewport)

	(vla-move 	(vla-copy 
				(vlax-ename->vla-object obj)
			);copy
				 (vlax-3d-point pt1) (vlax-3d-point pt2)
	 );move

)

140.dwg

Edited June 24, 2019 by Pradeep Kumar

[Pradeep Kumar]

I have  attached the picture how the program should be running and how it is running now. I hope you could understand the issue with this code.

 

 

Edited June 24, 2019 by Pradeep Kumar

[marko_ribar]

I could be that you have UCS not WCS issue...

[Pradeep Kumar]

how to rectify UCS issue ? 

[Lee Mac]

• Points obtained from the getpoint function are defined relative to the UCS.
• Polyline vertices and block insertion points are defined relative to the OCS.
• Points supplied to AutoCAD commands and the ssget point list are defined relative to the UCS.
• Points supplied to the ActiveX move method are defined relative to the WCS.

As such, change:

(IF (= PPA 10) (SETQ PPL (APPEND PPL (LIST PPV))))

To:

(IF (= PPA 10) (SETQ PPL (APPEND PPL (LIST (trans PPV pen 1)))))

Change:

(setq bpt (cdr (assoc 10 (entget (ssname sset ctr)))))

To:

(setq bpt (trans (cdr (assoc 10 (entget (ssname sset ctr)))) item 0))

Change:

(if (= chk 1) (PK:mycopy copyitem bpt fpt))

To:

(if (= chk 1) (PK:mycopy copyitem bpt (trans fpt 1 0)))

The above is untested, but should get you most of the way there.

Edited June 24, 2019 by Lee Mac

[Pradeep Kumar]

1 hour ago, Lee Mac said:

(setq bpt (trans (cdr (assoc 10 (entget (ssname sset ctr)))) item 0))

 

error: bad argument type: coordinate system specification: #<VLA-OBJECT IAcadBlockReference 000000003687dc18>

 

Thank you for helping me with the corrections, pointing out the mistakes and explaining them. Please help me further to complete this program.

[Pradeep Kumar]

1 hour ago, Lee Mac said:

(setq bpt (trans (cdr (assoc 10 (entget (ssname sset ctr)))) item 0))

 

I have used this instead 

(setq bpt (trans (cdr (assoc 10 (entget (ssname sset ctr)))) (ssname sset ctr) 0))

This way there was no error but still after correcting the Coordinate issue, the program runs just the way it was and I've post the code again so that you could have another glance at it to point out the mistakes.

	(defun c:ca()

(setq ctr1 0 chk 0)
(setq fpt (getpoint))
(command "ZOOM" "E")
(setq sset1 (ssget "x" '((0 . "LWPOLYLINE")(8 . "_Floor")) ))
(repeat (sslength sset1)
	(setq ctr 0)
 		(SETQ PEN (ssname sset1 ctr1))

 		(SETQ PENL (ENTGET PEN))
 		(SETQ PPL (LIST))
 	(FOREACH N PENL
 		(PROGN
   		(SETQ PPA (CAR N))
   		(SETQ PPV (CDR N))
   		(IF (= PPA 10) (SETQ PPL (APPEND PPL (LIST (trans PPV PEN 1)))))
 	));END N

	(setq sset (ssget "WP" PPL   ))
	(command "ZOOM" "E")
	(repeat (sslength sset)
	
		(setq item (ssname sset ctr))

		(setq item (vlax-ename->vla-object item))
		(setq layrname (vla-get-layer item))
	
	(setq tst (cdr (assoc 0 (entget (ssname sset ctr)))) )
	(if (= tst "LWPOLYLINE") (cond ((= layrname "_ResiFSI") (setq copyitem (ssname sset ctr)) 
	(setq chk 1)
	));cond
	);if
	(cond ((= layrname "_Floor")
		(cond ( (= tst "INSERT") 
			(setq blockname (cdr (assoc 2 (entget (ssname sset ctr)))))
		))
		)
	)
			(cond ((= "Direction Ref Point" blockname)

				(setq bpt (trans (cdr (assoc 10 (entget (ssname sset ctr)))) (ssname sset ctr) 0))
			))
	
		(setq ctr (1+ ctr))

	);repeat for block
;(princ copyitem)
(princ bpt)(princ "\n")
(princ fpt)

	(if (= chk 1) (PK:mycopy copyitem bpt (trans fpt 1 0)))
	(setq chk 0)
	(setq ctr1 (+ ctr1 1))

	);repeat for floor

);defun

(defun PK:mycopy(obj pt1 pt2)
(setq thisdrawing 
       (vla-get-activedocument 
               (vlax-get-acad-object)))

	(vla-Regen thisdrawing acActiveViewport)

	(vla-move 	(vla-copy 
				(vlax-ename->vla-object obj)
			);copy	
				 (vlax-3d-point pt1) (vlax-3d-point pt2)
	 );move

)

 

[Pradeep Kumar]

Please someone help me resolve this issue.

[Roy_043]

Your code has several issues. But the cause of the problem lies in this part (reformatted);

(cond
  ((= layrname "_Floor")
    (cond
      ((= tst "INSERT") 
        (setq blockname (cdr (assoc 2 (entget (ssname sset ctr)))))
      )
    )
  )
)

(cond
  ((= "Direction Ref Point" blockname) ; This returns T for items after the "Direction Ref Point" block.
    (setq bpt (cdr (assoc 10 (entget (ssname sset ctr)))))
  )
)

The bpt variable gets updated with point data from items processed after the block.

 

Consider this instead (note the use of 'and'):

(if
  (and
    (= "_Floor" layrname)
    (= "INSERT" tst) 
    (= "Direction Ref Point" (cdr (assoc 2 (entget (ssname sset ctr)))))
  )
  (setq bpt (cdr (assoc 10 (entget (ssname sset ctr)))))
)

 

[Pradeep Kumar]

Thanks a lot you are really a life saver !!