Community

Transform co-ordinates of vertices to work with entmake

Transform co-ordinates of vertices to work with entmake

dlbsurveysuk
Collaborator Collaborator
2,243 Views
39 Replies
Message 1 of 40

Transform co-ordinates of vertices to work with entmake

dlbsurveysuk
Collaborator
Collaborator
‎02-07-2024 02:30 AM

I've just rewritten some lisp routines that were annoyingly laggy, to use entmake instead of autocad commands. It has cured the laggyness. The routines include some simple trans commands to allow them to work in a UCS where the x,y plane is rotated around the z axis.

 

Attached example-LP-routines

 

I don't really understand these lines - (setq NORMAL (trans '(0.0 0.0 1.0) 2 0 T)) and (cons 50 (angle '(0.0 0.0 0.0) (trans '(1.0 0.0 0.0) 2 NORMAL T))) but they work ...

 

In another routine I'm now trying to entmake a 4 point closed polyline (rectangle) that is based upon the 2 points of a textbox, in a UCS created as follows -

 

WCS is rotated some amount in the x,y plane around the z axis.
UCS is set to view.
UCS is then rotated -90 degrees around the x axis and a new UCS is set.

 

The routine in it's current form using autocad commands works fine in the above UCS settings, but I'd like to convert it to using entmake, and I can't figure out what trans coding I need to use.

 

Routine attached in it's current working form with the possible entmake part currently commented out (arrow-down-annotated).

 

Thanks for any help.

example-LP-routines.lsp
arrow-down-annotated.lsp
0 Likes
Like
Report
Accepted solutions (2)
Solution 1
Solution 2
2,244 Views
39 Replies
Replies (39)
Message 21 of 40

Sea-Haven
Mentor
Mentor
‎02-10-2024 03:04 PM

This works for me, 

(defun M-Text-mask (pt str lay /  )
(entmakex (list
(cons 0 "MTEXT")         
(cons 100 "AcDbEntity")
(cons 100 "AcDbMText")
(cons 10 pt)
(cons 8 lay)
(cons 1 str)
(cons 7 "Standard")
(cons 90 1)
(cons 63 1)
(cons 45 1.2) 
(cons 441 0)
))
)

AutoCAD 2022 Help | MTEXT (DXF) | Autodesk

 

0 Likes
Like
Report
Message 22 of 40

john.uhden
Mentor
Mentor
in reply to Sea-Haven
‎02-10-2024 04:01 PM

@Sea-Haven ,

I'm sorry.  Don't know why but...

Command: (m-text-mask p str "1")
; error: bad DXF group: (441 . 0)

John F. Uhden

0 Likes
Like
Report
Message 23 of 40

Sea-Haven
Mentor
Mentor
in reply to john.uhden
‎02-10-2024 07:18 PM

Works ok for me does layer "1" exist ? Bricscad V20

 

 

(setq pt (getpoint) str "ASDF" lay "0")
(M-Text-mask pt str lay)

 

Note color is 63 

0 Likes
Like
Report
Message 24 of 40

john.uhden
Mentor
Mentor
in reply to Sea-Haven
‎02-11-2024 09:11 AM

@Sea-Haven ,

AutoCAD's entmake will create the layer if it doesn't already exist.

John F. Uhden

0 Likes
Like
Report
Message 25 of 40

komondormrex
Mentor
Mentor
‎02-11-2024 10:32 PM

@dlbsurveysuk 

is it that you want to really draw with you routines? i mean the position of arrow and mtexts and mtext contents in any ucs set by view?

 

komondormrex_0-1707719525307.png

 

0 Likes
Like
Report
Message 26 of 40

dlbsurveysuk
Collaborator
Collaborator
in reply to komondormrex
‎02-12-2024 01:09 AM

I want them as attached.

 

I thought the attached routine was working but it only seems to work in some UCS cases...

 

Using the attached DWG - rotate to new orientation - set UCS View - draw a couple of lines/arcs - test the Lisp.

Blank-Test.dwg
29 KB
arrow-down-annotated-V2.lsp
0 Likes
Like
Report
Message 27 of 40

dlbsurveysuk
Collaborator
Collaborator
in reply to dlbsurveysuk
‎02-12-2024 01:10 AM

Another thing that happens is that the arhead block is filled in in WCS, but only shows it's outline in UCS.

15 KB
0 Likes
Like
Report
Message 28 of 40

komondormrex
Mentor
Mentor
in reply to dlbsurveysuk
‎02-12-2024 01:52 AM

you are using 3d wireframe visualization, so those problems such as different mtext mask color, filled/not filled arrow block is its result. with 2d wireframe you can avoid first in wcs only  but cannot second at all. 

0 Likes
Like
Report
Message 29 of 40

komondormrex
Mentor
Mentor
in reply to dlbsurveysuk
‎02-12-2024 02:01 AM
Accepted solution

i do not actually like the idea of trimming arrow line in halves, so i did write full dynamic version for your i believe purposes. should be working in any ucs. horizontal or vertical orientation is auto selected based upon delta x/y. text values are cycling with right mouse clicking. one thing which is remained unsolved is when there are several intersections of arrow and target pline or whatever. in such a case program will definitely fail.

 

 

;*******************************************************************************************************************************************************

;	komondormrex, feb 2024

;*******************************************************************************************************************************************************

(defun c:mark_arrow (/ s_point text_size line line_dxf arrow e_point mtext text_value_list)
	(if (zerop (boole 1 512 (getvar 'osmode))) (setvar 'osmode (boole 6 512 (getvar 'osmode))))
	(setq s_point (getpoint "\nStart point of marking line: ")
		  text_size (getvar 'textsize) 
		  line (vla-addline (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
	                  					   (vlax-3d-point (trans s_point 1 0))(vlax-3d-point (trans s_point 1 0))
	           )
		  arrow	(vla-insertblock (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
							  	 (vlax-3d-point s_point) "ArHead" text_size text_size text_size 0
				)
		  text_value_list '("Clg Dn" "Slates Down" "Tiles Down")
		  text_index (if (null text_index) 0 text_index)
		  mtext (vla-addmtext (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
							  (vlax-3d-point (setq mtext_insertion_point (trans s_point 1 0)))
							  0 (nth text_index text_value_list)
			    )
	)
	(entmod (subst (cons 8 "gtext") (assoc 8 (setq line_dxf (entget (vlax-vla-object->ename line)))) line_dxf))
	(vla-put-attachmentpoint mtext 5)
	(vla-put-height mtext text_size)
	(vlax-put mtext 'backgroundfill 1)
	(vla-put-layer mtext "gtext")
	(vla-put-layer arrow "gtext")
	(vla-put-rotation mtext 0)
	(while (and (setq e_point (grread t 5 2)) (/= 3 (car e_point)))
		(if (member (car e_point) '(11 25))
			(progn
				(setq text_index (if (= 3 (setq text_index (1+ text_index))) 0 text_index))
				(vla-put-textstring mtext (nth text_index text_value_list)) 
			)
			(progn
				(setq e_point (cadr e_point))
				(if (apply '< (mapcar 'abs (mapcar '- s_point e_point '(0 0))))
					(progn
						(vla-put-endpoint line (vlax-3d-point (trans (list (car s_point) (cadr e_point) 0) 1 0)))
						(vla-put-insertionpoint arrow (vlax-3d-point (trans (list (car s_point) (cadr e_point) 0) 1 0)))
						(vla-put-rotation arrow (if (> (cadr s_point) (cadr e_point)) (* 0.5 pi) (* 1.5 pi)))
					)
					(progn
						(vla-put-endpoint line (vlax-3d-point (trans (list (car e_point) (cadr s_point) 0) 1 0)))
						(vla-put-insertionpoint arrow (vlax-3d-point (trans (list (car e_point) (cadr s_point) 0) 1 0)))
						(vla-put-rotation arrow (if (> (car s_point) (car e_point)) 0 pi))
					)
				)
				(vla-put-insertionpoint mtext (vlax-3d-point (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (vlax-get line 'startpoint) (vlax-get line 'endpoint)))))
			)
		)
	)
	(setq e_point (cadr e_point))
	(vlax-put line 'endpoint (vlax-invoke line 'intersectwith (vlax-ename->vla-object (car (nentselp e_point))) acextendthisentity))
	(vla-put-insertionpoint arrow (vla-get-endpoint line))
	(vla-put-insertionpoint mtext (vlax-3d-point (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (vlax-get line 'startpoint) (vlax-get line 'endpoint)))))
	(princ)
)

;*******************************************************************************************************************************************************

 

 

Report
Message 30 of 40

dlbsurveysuk
Collaborator
Collaborator
in reply to komondormrex
‎02-12-2024 02:30 AM

That's fantastic. I like the way of cycling through the text options. Works great in all UCSs.

 

I'm still getting the same background mask results as mentioned before (see attached image). I get this if I manually add some MTEXT and right click in the editor to change the background mask settings so could this be something to do with my graphics setup?

 

Also (as mentioned previously) do you know what might be causing the ARHEAD to show only in outline in a UCS?

 

Thanks a lot for you coding, much appreciated.

27 KB
0 Likes
Like
Report
Message 31 of 40

komondormrex
Mentor
Mentor
in reply to dlbsurveysuk
‎02-12-2024 02:32 AM

read message 28.

Report
Message 32 of 40

dlbsurveysuk
Collaborator
Collaborator
in reply to komondormrex
‎02-12-2024 02:36 AM

OK. Sorry I missed that message. Thanks a lot for explaining.

0 Likes
Like
Report
Message 33 of 40

dlbsurveysuk
Collaborator
Collaborator
in reply to dlbsurveysuk
‎02-12-2024 02:44 AM

OK. If I copy paste into a 2D wireframe dwg everything is fine (see image).

23 KB
Report
Message 34 of 40

dlbsurveysuk
Collaborator
Collaborator
in reply to komondormrex
‎02-12-2024 03:33 AM

I've noticed a problem...

 

If the UCS is the xy plane rotated around the z-axis  (so the direction of the z-axis hasn't changed from WCS) the ARHEAD is rotated to the WCS.

 

If the UCS has the direction of the z-axis changed everything is fine....

 

(I think I've explained that correctly...

22 KB
xy plane rotated.dwg
0 Likes
Like
Report
Message 35 of 40

komondormrex
Mentor
Mentor
in reply to dlbsurveysuk
‎02-12-2024 03:57 AM

will check it later

0 Likes
Like
Report
Message 36 of 40

dlbsurveysuk
Collaborator
Collaborator
in reply to komondormrex
‎02-12-2024 04:14 AM

ok, no problem. Thanks

0 Likes
Like
Report
Message 37 of 40

john.uhden
Mentor
Mentor
in reply to dlbsurveysuk
‎02-12-2024 11:59 AM

@dlbsurveysuk ,

As to the arrowhead, that is a function of the leader or mleader style.  Your picture represents a "Closed" arrow, but you probably want to use "Close Filled."

I also noticed that the leaders are in front of the text.  If both are parts of the same Mleader, then I don't know how to get just the text in front, other than to use the older method of Mtext with an associated leader.

John F. Uhden

0 Likes
Like
Report
Message 38 of 40

dlbsurveysuk
Collaborator
Collaborator
in reply to komondormrex
‎02-12-2024 09:10 PM

Hi, I think this works...

Added check if z of UCSYDIR is zero, then if so, add the x-axis rotation from world to UCS to the arrow rotation.

 

 

;*******************************************************************************************************************************************************

;	komondormrex, feb 2024

;*******************************************************************************************************************************************************

(defun c:mark_arrow (/ xAng s_point text_size line line_dxf arrow e_point mtext text_value_list)

      (setq xAng (angle '(0. 0. 0.) (trans (getvar 'UCSXDIR) 0 (trans '(0. 0. 1.) 1 0 t) t))) ;;;correct for UCS X-Axis rotation
  
	(if (zerop (boole 1 512 (getvar 'osmode))) (setvar 'osmode (boole 6 512 (getvar 'osmode))))
	(setq s_point (getpoint "\nStart point of marking line: ")
		  text_size (getvar 'textsize) 
		  line (vla-addline (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
	                  					   (vlax-3d-point (trans s_point 1 0))(vlax-3d-point (trans s_point 1 0))
	           )
		  arrow	(vla-insertblock (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
							  	 (vlax-3d-point s_point) "ArHead" text_size text_size text_size 0
				)
		  text_value_list '("Clg Dn" "Slates Down" "Tiles Down")
		  text_index (if (null text_index) 0 text_index)
		  mtext (vla-addmtext (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
							  (vlax-3d-point (setq mtext_insertion_point (trans s_point 1 0)))
							  0 (nth text_index text_value_list)
			    )
	)
	(entmod (subst (cons 8 "gtext") (assoc 8 (setq line_dxf (entget (vlax-vla-object->ename line)))) line_dxf))
	(vla-put-attachmentpoint mtext 5)
	(vla-put-height mtext text_size)
	(vlax-put mtext 'backgroundfill 1)
	(vla-put-layer mtext "gtext")
	(vla-put-layer arrow "gtext")
	(vla-put-rotation mtext 0)
	(while (and (setq e_point (grread t 5 2)) (/= 3 (car e_point)))
		(if (member (car e_point) '(11 25))
			(progn
				(setq text_index (if (= 3 (setq text_index (1+ text_index))) 0 text_index))
				(vla-put-textstring mtext (nth text_index text_value_list)) 
			)
			(progn
				(setq e_point (cadr e_point))
				(if (apply '< (mapcar 'abs (mapcar '- s_point e_point '(0 0))))
					(progn
						(vla-put-endpoint line (vlax-3d-point (trans (list (car s_point) (cadr e_point) 0) 1 0)))
						(vla-put-insertionpoint arrow (vlax-3d-point (trans (list (car s_point) (cadr e_point) 0) 1 0)))
;;;						(vla-put-rotation arrow (if (> (cadr s_point) (cadr e_point)) (* 0.5 pi) (* 1.5 pi)))
					  	(if (= (caddr (getvar 'ucsydir)) 0)
						  (vla-put-rotation arrow (if (> (cadr s_point) (cadr e_point)) (+ (* 0.5 pi) xAng) (+ (* 1.5 pi) xAng)))
						  (vla-put-rotation arrow (if (> (cadr s_point) (cadr e_point)) (* 0.5 pi) (* 1.5 pi))))
					)
					(progn
						(vla-put-endpoint line (vlax-3d-point (trans (list (car e_point) (cadr s_point) 0) 1 0)))
						(vla-put-insertionpoint arrow (vlax-3d-point (trans (list (car e_point) (cadr s_point) 0) 1 0)))
;;;						(vla-put-rotation arrow (if (> (car s_point) (car e_point)) 0 pi))
					  	(if (= (caddr (getvar 'ucsydir)) 0)
						  (vla-put-rotation arrow (if (> (car s_point) (car e_point)) xAng (+ pi xAng)))
						  (vla-put-rotation arrow (if (> (car s_point) (car e_point)) 0 pi)))
					)
				)
				(vla-put-insertionpoint mtext (vlax-3d-point (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (vlax-get line 'startpoint) (vlax-get line 'endpoint)))))
			)
		)
	)
	(setq e_point (cadr e_point))
	(vlax-put line 'endpoint (vlax-invoke line 'intersectwith (vlax-ename->vla-object (car (nentselp e_point))) acextendthisentity))
	(vla-put-insertionpoint arrow (vla-get-endpoint line))
	(vla-put-insertionpoint mtext (vlax-3d-point (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (vlax-get line 'startpoint) (vlax-get line 'endpoint)))))
	(princ)
)

 

 

Report
Message 39 of 40

komondormrex
Mentor
Mentor
in reply to dlbsurveysuk
‎02-12-2024 10:27 PM

hey there,

me too, line 56. hope that was the last bug you found testing. i have also added defining an arhead block in the drawing if there is not one.

 

 

 

;*******************************************************************************************************************************************************

;	komondormrex, feb 2024

;*******************************************************************************************************************************************************

(defun c:mark_arrow (/ s_point text_size line line_dxf arrow e_point mtext text_value_list)
	(if (vl-catch-all-error-p (vl-catch-all-apply 'vla-item (list (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) "ArHead")))
		(vla-addsolid (vla-add (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (vlax-3d-point '(0 0 0)) "ArHead") 
						  (vlax-3d-point '(0 0 0)) (vlax-3d-point '(1 0.25 0)) (vlax-3d-point '(0 0 0)) (vlax-3d-point '(1 -0.25 0))
		)
	)
	(if (zerop (boole 1 512 (getvar 'osmode))) (setvar 'osmode (boole 6 512 (getvar 'osmode))))
	(setq s_point (getpoint "\nStart point of marking line: ")
		  text_size (getvar 'textsize)
		  line (vla-addline (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
	                  					   (vlax-3d-point (trans s_point 1 0))(vlax-3d-point (trans s_point 1 0))
	           )
		  arrow	(vla-insertblock (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
							  	 (vlax-3d-point s_point) "ArHead" text_size text_size text_size 0
				)
		  text_value_list '("Clg Dn" "Slates Down" "Tiles Down")
		  text_index (if (null text_index) 0 text_index)
		  mtext (vla-addmtext (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
							  (vlax-3d-point (setq mtext_insertion_point (trans s_point 1 0)))
							  0 (nth text_index text_value_list)
			    )
	)
	(entmod (subst (cons 8 "gtext") (assoc 8 (setq line_dxf (entget (vlax-vla-object->ename line)))) line_dxf))
	(vla-put-attachmentpoint mtext 5)
	(vla-put-height mtext text_size)
	(vlax-put mtext 'backgroundfill 1)
	(vla-put-layer mtext "gtext")
	(vla-put-layer arrow "gtext")
	(vla-put-rotation mtext 0)
	(while (and (setq e_point (grread t 5 2)) (/= 3 (car e_point)))
		(if (member (car e_point) '(11 25))
			(progn
				(setq text_index (if (= (length text_value_list) (setq text_index (1+ text_index))) 0 text_index))
				(vla-put-textstring mtext (nth text_index text_value_list))
			)
			(progn
				(setq e_point (cadr e_point))
				(if (apply '< (mapcar 'abs (mapcar '- s_point e_point '(0 0))))
					(progn
						(vla-put-endpoint line (vlax-3d-point (trans (list (car s_point) (cadr e_point) 0) 1 0)))
						(vla-put-insertionpoint arrow (vlax-3d-point (trans (list (car s_point) (cadr e_point) 0) 1 0)))
						(vla-put-rotation arrow (if (> (cadr s_point) (cadr e_point)) (* 0.5 pi) (* 1.5 pi)))
					)
					(progn
						(vla-put-endpoint line (vlax-3d-point (trans (list (car e_point) (cadr s_point) 0) 1 0)))
						(vla-put-insertionpoint arrow (vlax-3d-point (trans (list (car e_point) (cadr s_point) 0) 1 0)))
						(vla-put-rotation arrow (if (> (car s_point) (car e_point)) 0 pi))
					)
				)
          		(if (equal 0 (+ (abs (caddr (getvar 'ucsxdir))) (abs (caddr (getvar 'ucsydir)))) 1e-10) (vla-put-rotation arrow (+ pi (vla-get-angle line))))
				(vla-put-insertionpoint mtext (vlax-3d-point (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (vlax-get line 'startpoint) (vlax-get line 'endpoint)))))
			)
		)
	)
	(setq e_point (cadr e_point))
	(vlax-put line 'endpoint (vlax-invoke line 'intersectwith (vlax-ename->vla-object (car (nentselp e_point))) acextendthisentity))
	(vla-put-insertionpoint arrow (vla-get-endpoint line))
	(vla-put-insertionpoint mtext (vlax-3d-point (mapcar '* '(0.5 0.5 0.5) (mapcar '+ (vlax-get line 'startpoint) (vlax-get line 'endpoint)))))
	(princ)
)

;*******************************************************************************************************************************************************

 

 

 

 

 

Report
Message 40 of 40

dlbsurveysuk
Collaborator
Collaborator
in reply to komondormrex
‎02-13-2024 12:58 AM

Your bug squashing is more efficiently coded plus you've accounted for not being exactly zero (which is something I should have known because a similar thing came up recently in another thread).

 

Thanks very much.

0 Likes
Like
Report
Report a website issue