Jump to content

Moving obect but inconsistance destination point


Pradeep Kumar

Recommended Posts

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 by Pradeep Kumar
Link to comment
Share on other sites

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.

 

 

How it should be.jpg

How it is.JPG

Edited by Pradeep Kumar
Link to comment
Share on other sites

  • 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 by Lee Mac
  • Thanks 1
Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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

)

 

Link to comment
Share on other sites

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)))))
)

 

  • Thanks 1
Link to comment
Share on other sites

  • 2 weeks later...

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...