Topic: Help with a lisp :Point perpendicular to line

[pedroantonio]

Hi .I am using this lisp to draw perpendicular line from a point to line.
I want to do a change .don't draw me a line but insert a point onthe section of the tow lines like the photo

Code - Auto/Visual Lisp: [Select]

1. (defun c:perp (/ e 2p ad d p pp) ;perpendicular to line
2. ;hanhphuc 29.10.15
3. (COMMAND "_layer" "_m" "section" "_c" "10" "" "")
4. (setvar 'pdmode 35)
5.   (if (and (setq e (car (entsel "\nPick a LINE.. ")))
6.            (= (cdr (assoc 0 (setq e (entget e)))) "LINE")
7.            )
8.     (while (setq p (getpoint "\nSpecify a POINT.. "))
9.       (setq 2p (mapcar ''((x) (trans (cdr (assoc x e))0 1) ) '(10 11))
10.             ad (mapcar '(lambda (f) (apply f (mapcar ''((x) (list (car x) (cadr x))) 2p)))
11.                        '(angle distance))
12.             d  (vxv (mapcar '- p (car 2p)) (mapcar ''((f) (f (car ad))) (list cos sin)))
13.             pp (polar (car 2p) (car ad) d)
14.             )
15.       (entmakex
16.         (vl-list* '(0 . "LINE")
17.                   (mapcar '(lambda (a b) (cons a (trans b 1 0)))
18.                           '(10 11)
19.                           (list p
20.                                 (list (car pp)(cadr pp)(+ (* (/ (apply '- (mapcar 'last (reverse 2p))) (cadr ad)) d)
21.                                           (caddr (car 2p)))
22.                                        )
23.                                 )
24.                           )
25.                   )
26.         )
27.       )
28.     )
29.   (princ)
30.   )
31.  
32. ;; Vector Dot Product  -  Lee Mac
33. ;; Args: u,v - vectors in R^n
34.  
35. (defun vxv ( u v )
36.     (apply '+ (mapcar '* u v))
37. )
38.  
39.  

Thanks

[BIGAL]

Much easier done with vla-getclosestpointto pick line pick point done.

Code: [Select]

(setq pt (getpoint))
(setq obj (vlax-ename->vla-object (car (entsel "\nPick line"))))
(setq pt2 (vlax-curve-getclosestpointto obj  pt))


[pedroantonio]

hi bigal. The  change ineed to do is this

a) select the line (or pt1 and pt2)
b) select pt3
c) draw a perpedicular point on the line pt1 -->pt2
with
(COMMAND "_layer" "_m" "section" "_c" "10" "" "")
(setvar 'pdmode 35)

Can you help me?

thanks

[Lee Mac]

Try the following:

Code - Auto/Visual Lisp: [Select]

1. (defun c:perpt ( / dis enx pt1 pt2 pt3 sel tmp )
2.     (while
3.         (not
4.             (progn (setvar 'errno 0) (setq sel (entsel "\nSelect line or polyline segment: "))
5.                 (cond
6.                     (   (= 7 (getvar 'errno))
7.                         (prompt "\nMissed, try again.")
8.                     )
9.                     (   (null sel))
10.                     (   (= "LINE" (cdr (assoc 0 (setq enx (entget (car sel))))))
11.                         (setq pt1 (trans (cdr (assoc 10 enx)) 0 1)
12.                               pt2 (trans (cdr (assoc 11 enx)) 0 1)
13.                               dis (distance pt1 pt2)
14.                         )
15.                     )
16.                     (   (= "LWPOLYLINE" (cdr (assoc 0 enx)))
17.                         (setq tmp (vlax-curve-getclosestpointto (car sel) (trans (cadr sel) 1 0))
18.                               tmp (fix (+ 1e-8 (vlax-curve-getparamatpoint (car sel) tmp)))
19.                               pt1 (trans (vlax-curve-getpointatparam (car sel)     tmp)  0 1)
20.                               pt2 (trans (vlax-curve-getpointatparam (car sel) (1+ tmp)) 0 1)
21.                               dis (distance pt1 pt2)
22.                         )
23.                     )
24.                     (   (prompt "\nThe selected object is not a line or 2D polyline."))
25.                 )
26.             )
27.         )
28.     )
29.     (if (and pt1 pt2 (setq pt3 (getpoint "\nSpecify 3rd point: ")))
30.         (entmake
31.             (list
32.                '(000 . "POINT")
33.                '(008 . "section")
34.                 (cons 010
35.                     (trans
36.                         (polar pt1
37.                             (angle pt1 pt2)
38.                             (apply '+
39.                                 (mapcar '*
40.                                     (mapcar '- pt3 pt1)
41.                                     (mapcar '(lambda ( a b ) (/ (- a b) dis)) pt2 pt1)
42.                                 )
43.                             )
44.                         )
45.                         1 0
46.                     )
47.                 )
48.                 (cons 210 (trans '(0 0 1) 1 0 t))
49.             )
50.         )
51.     )
52.     (princ)
53. )

[pedroantonio]

thank you  Lee Mac