Few lisps to improve workflow

Few lisps to improve workflow

Lukasvop1
Advocate Advocate
3,649 Views
48 Replies
Message 1 of 49

Few lisps to improve workflow

Lukasvop1
Advocate
Advocate

Hi guys, can you check this. I need create this few easy lisps separatly. Can you help?

 

1. LDN - Laydel, Name
2. MPT - Multiple Point
3. ZO - Zoom object
4. LP - Line perpendicular
5. LTA - Line tangent
6. C3T - tan, tan, tan

 

 

@komondormrex

Simple_lisps.png

 

0 Likes
3,650 Views
48 Replies
  • Lisp
Replies (48)
Message 41 of 49

Lukasvop1
Advocate
Advocate

Absolutely perfect, thanks.

0 Likes
Message 42 of 49

ВeekeeCZ
Consultant
Consultant

@Kent1Cooper wrote:

@stev98312 wrote:

Because LAYDEL is an Express Tool. ....


It may have been originally, but since at least Acad2020 [maybe earlier] it's been a "real" command that can be called in an AutoLisp (command) function.


 

It was 2007 🙂

0 Likes
Message 43 of 49

hak_vz
Advisor
Advisor

Or maybe this for LTA

 

(defun c:LTA ( / *error* e eo pointlist2d2 p1 p2 c1 c1o r1 cp1 r2 cp2 c2o)
	(defun *error* ( msg )
		(if (not (member msg '("Function cancelled" "quit / exit abort")))
			(princ (strcat "\nError: " msg))
		)
		(setvar 'osmode old_osn)
		(setvar 'cmdecho 1)
		(princ)
	)
	(defun pointlist2d (lst / ret) (while lst (setq	ret (cons (list (car lst) (cadr lst)) ret) lst (cddr lst) ) ) (reverse ret))	
	(setq e (car (entsel "\nSelect tangent line >")))
	(cond 
		((and e)
			(setvar 'cmdecho 0)
			(setq eo (vlax-ename->vla-object e))
			(cond
				((= (vlax-get eo 'ObjectName) "AcDbLine")
					(setq
						p1 (vlax-get eo 'StartPoint)
						p2 (vlax-get eo 'EndPoint)
					)
				)
				((= (vlax-get eo 'ObjectName) "AcDbPolyline")
					(mapcar 'set '(p1 p2) (pointlist2d (vlax-get eo 'Coordinates)))
				)
				(T "\nSelected object is not suitable tangent entity!")
			)
			(setq c1 (ssname (ssget "_C" (mapcar '- p1 '(1 1)) (mapcar '+ p1 '(0.15 0.15)) '((0 . "CIRCLE"))) 0))
			(setq c1o (vlax-ename->vla-object (ssname (ssget "_C" (mapcar '- p1 '(1 1)) (mapcar '+ p1 '(1 1)) '((0 . "CIRCLE"))) 0)))
			(setq r1 (vlax-get c1o 'radius))
			(setq cp1 (vlax-get c1o 'center))
			(setq r2 (getreal "\nEnter radius of second circle >"))
			(setq cp2 (polar p2 (angle p1 cp1) r2))
			(command "_.copy" c1 "" cp1 cp2)
			(setq c2o (vlax-ename->vla-object (entlast)))
			(vlax-put c2o 'radius r2)
			(setq old_osn (getvar 'osmode))
			(setvar 'osmode 0)
			(command "_.mirror" e ""  cp1 cp2 "N")
			(setvar 'osmode old_osn)
			(setvar 'cmdecho 1)
		)
	)
	(princ)
)

 

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
0 Likes
Message 44 of 49

Lukasvop1
Advocate
Advocate
Thank you, but this is not working..
0 Likes
Message 45 of 49

Lukasvop1
Advocate
Advocate
Accepted solution
 
To get a better overview, I summarized all created lisps, which I tried and working for me.
Thank you all guys who you responded.
 
 
 
1. LDN - Laydel, Name
2. MPT - Multiple Point
3. ZO - Zoom object
4. LP - Line perpendicular
5. LTA - Line tangent
6. C3T - tan, tan, tan
 
 
 
 
 
 
1. LDN - Laydel, Name
 

 

(defun c:ldn (/ aec_sendkeys)
 (defun aec_sendkeys (cmd-arg)
 (vla-Sendcommand(vla-Get-ActiveDocument(vlax-Get-Acad-Object))cmd-arg)(princ)
 )
 (aec_SendKeys "_.Laydel _Name\n")
)

 

 

 

(defun C:LDN ()
(initcommandversion)
(command "_.laydel" "_n")
(prin1)
)

 

 
2. MPT - Multiple Point
 

 

(defun c:mpt(/ pnt)
  (while (setq pnt (getpoint "\nSpecify a point: "))(command "_.point" pnt))
  (princ)
)

 

 
3. ZO - Zoom object
 

 

(defun c:zo ()
(command "_.zoom" "_o")
) ; defun zo

 

 

 

(defun c:zo( / ss)
(cond 
((setq ss (last(ssgetfirst)))
(command "_.zoom" "_O" ss "") 
)
(T
(princ "\nSelect object(s) to zoom to > ")
(command "_.zoom" "_O" (ssget) "")
)
)
(princ)
)

 

 
 
4. LP - Line perpendicular
 

 

(defun c:LP ()
  (command "_.line" "_per")
  (prin1)
)

 

 
 
5. LTA - Line tangent
 

 

(defun c:LTA (/ old_osmode)
(setq old_osmode (getvar 'osmode))
(setvar 'osmode 256)
(command "_line" pause pause "")
(setvar 'osmode old_osmode)
)

 

 
6. C3T - tan, tan, tan
 

 

(defun c:C3T()
(command "_.circle" "_3p" "_tan" pause "_tan" pause "_tan" pause)
(princ)
)

 

 

 

(defun c:c3t (/ *error* LM:intersections a1 a2 a3 e1 e2 e3 p1 p2 p3 a b c s r cp)
(defun *error* ( msg )
(if (not (member msg '("Function cancelled" "quit / exit abort")))
(princ (strcat "\nError: " msg))
)
(setvar 'cmdecho 1)
(princ)
)
(defun LM:intersections ( ob1 ob2 mod / lst rtn )
(if (and (vlax-method-applicable-p ob1 'intersectwith)
(vlax-method-applicable-p ob2 'intersectwith)
(setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
)
(repeat (/ (length lst) 3)
(setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
  lst (cdddr lst)
)
)
)
(reverse rtn)
)
(setvar 'cmdecho 0)
(setq
a1 (car(entsel "\nSelect first tangent line >"))
a2 (car(entsel "\nSelect second tangent line >"))
a3 (car (entsel "\nSelect third tangent line >"))
)
(cond 
((and a1 a2 a3)
(mapcar 'set '(e1 e2 e3) (mapcar 'vlax-ename->vla-object (list a1 a2 a3))) 
(setq 
p1 (car(LM:intersections e1 e2 acextendnone))
p2 (car(LM:intersections e2 e3 acextendnone))
p3 (car(LM:intersections e3 e1 acextendnone))
a (distance p1 p2)
b (distance p2 p3)
c (distance p3 p1)
s (* 0.5 (+ a b c))
r (sqrt (/ (* (- s a)(- s b)(- s c)) s))
)
(command "_.xline" "B" p1 p2 p3 "")
(setq a1 (entlast))
(setq e1 (vlax-ename->vla-object (entlast)))
(command "_.xline" "B" p2 p1 p3 "")
(setq a2 (entlast))
(setq e2 (vlax-ename->vla-object (entlast)))
(setq cp (car(LM:intersections e1 e2 acextendnone)))
(command "_.circle" cp r)
(command "_.erase" a1 a2 "")
)
)
(setvar 'cmdecho 1)
(princ)
)

 

 
 
0 Likes
Message 46 of 49

hak_vz
Advisor
Advisor

@Lukasvop1 wrote:
Thank you, but this is not working..

@Lukasvop1 

 

No it works perfectly fine and as you requested. Create tangent on first circle as a line object. In autocad pline command will pick nearest point as tangent line while line command moves first tangent point as you move cursor in direction of second tangent point. Create line as single segment. Run LTA, select tangent line and enter radius for second circle.

 

Solution by @komondormrex  requires that you have two circles and creates tangent line touching both circles, by simply putting osmode to tangent, and this is actually proper way to do it. In reality lisp is not needed for this, but just tangent osmode has to be turned on. My code is made according to your request was exactly i.e from tangent create circle.

 

Since at work I don't use autocad I have to admit that code works lots better in that app, both for pline and line tangent objects and without need to suppress  osmode to perform mirror operation.

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
0 Likes
Message 47 of 49

Lukasvop1
Advocate
Advocate
@komondormrex did exactly I want.
0 Likes
Message 48 of 49

hak_vz
Advisor
Advisor

He solved LTA option 2, I solved option 1 according to image you originally posted. In video option 1 is something else since you there you have two tangent lines. Since tangent lines are axially symmetric to line that joins two circle center point I don't know how you can originally create two tangent as in your video, but OK.

 

Regarding my solution only question is do you have second circle radius predefined or not?

Miljenko Hatlak

EESignature

Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
0 Likes
Message 49 of 49

Lukasvop1
Advocate
Advocate
I didn't realized, lisp LTA was about snapping mode. Maybe I described it confusing.
But this is what I wanted
0 Likes