Perpendicular line from multiple BLOCK BASE POINT to Polyline

[mint09]

is it possible to change this lisp to get Perpendicular line from a Point to Perpendicular line from a BLOCK BASE POINT ?

i mean first select the polyline and then select all blocks and it'll create a perpendicular line to the polyline/line/arc ive selected and draw a line. The lisp above creates the same but i can only select points, not blocks.

(defun c:ppl ( / ent idx pnt sel )
    (if
        (and (setq sel (LM:ssget "\nSelect points: " '(((0 . "POINT")))))
            (progn
                (while
                    (progn (setvar 'errno 0) (setq ent (entsel "\nSelect curve: "))
                        (cond
                            (   (= 7 (getvar 'errno))
                                (princ "\nMissed, try again.")
                            )
                            (   (null ent) nil)
                            (   (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getclosestpointto ent))
                                (princ "\nInvalid object selected.")
                            )
                        )
                    )
                )
                (setq ent (car ent))
            )
        )
        (repeat (setq idx (sslength sel))
            (setq idx (1- idx)
                  pnt (assoc 10 (entget (ssname sel idx)))
            )
            (entmake (list '(0 . "LINE") pnt (cons 11 (vlax-curve-getclosestpointto ent (cdr pnt)))))
        )
    )
    (princ)
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)
(vl-load-com) (princ)

i don't know much about lisp codes and all, please help if possible.. Thanks..

[dlanorh · Accepted solution]

---

@mint09 wrote:

is it possible to change this lisp to get Perpendicular line from a Point to Perpendicular line from a BLOCK BASE POINT ?

i mean first select the polyline and then select all blocks and it'll create a perpendicular line to the polyline/line/arc ive selected and draw a line. The lisp above creates the same but i can only select points, not blocks.

(defun c:ppl ( / ent idx pnt sel )
    (if
        (and (setq sel (LM:ssget "\nSelect points: " '(((0 . "POINT,INSERT")))))
            (progn
                (while
                    (progn (setvar 'errno 0) (setq ent (entsel "\nSelect curve: "))
                        (cond
                            (   (= 7 (getvar 'errno))
                                (princ "\nMissed, try again.")
                            )
                            (   (null ent) nil)
                            (   (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getclosestpointto ent))
                                (princ "\nInvalid object selected.")
                            )
                        )
                    )
                )
                (setq ent (car ent))
            )
        )
        (repeat (setq idx (sslength sel))
            (setq idx (1- idx)
                  pnt (assoc 10 (entget (ssname sel idx)))
            )
            (entmake (list '(0 . "LINE") pnt (cons 11 (vlax-curve-getclosestpointto ent (cdr pnt)))))
        )
    )
    (princ)
)

;; ssget  -  Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
    (princ msg)
    (setvar 'nomutt 1)
    (setq sel (vl-catch-all-apply 'ssget arg))
    (setvar 'nomutt 0)
    (if (not (vl-catch-all-error-p sel)) sel)
)
(vl-load-com) (princ)

i don't know much about lisp codes and all, please help if possible.. Thanks..

---

Make the change in RED above and try that

[ВeekeeCZ · Accepted solution]

... and swapped order of selection...

(defun c:ppl ( / ent idx pnt sel )
  (if (progn
	(while
	  (progn (setvar 'errno 0) (setq ent (entsel "\nSelect curve: "))
	    (cond
	      (   (= 7 (getvar 'errno))
	       (princ "\nMissed, try again.")
	       )
	      (   (null ent) nil)
	      (   (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getclosestpointto ent))
	       (princ "\nInvalid object selected.")
	       )
	      )
	    )
	  )
	(setq ent (car ent))
	)
    (while (setq sel (ssget "_:S" '((0 . "POINT,INSERT"))))
      (repeat (setq idx (sslength sel))
	(setq idx (1- idx)
	      pnt (assoc 10 (entget (ssname sel idx)))
	      )
	(entmake (list '(0 . "LINE") pnt (cons 11 (vlax-curve-getclosestpointto ent (cdr pnt)))))
	)
      ))
  (princ)
  )

(vl-load-com) (princ)

[john.uhden]

I see a problem with the code.

vlax-curve-getclosestpointto may easily return a point that's the beginning or end or a vertex, not necessarily perpendicular to the curve object.  Now it's all fine if what you meant by the word "perpendicular" is really the closest point

As far as blocks vs. points, the assoc 10 applies to both.

[ronjonp · Accepted solution]

Solution HERE too.

[ronjonp]

---

@john.uhden wrote:

I see a problem with the code.

vlax-curve-getclosestpointto may easily return a point that's the beginning or end or a vertex, not necessarily perpendicular to the curve object.  Now it's all fine if what you meant by the word "perpendicular" is really the closest point

As far as blocks vs. points, the assoc 10 applies to both.

---

Maybe something more like this ? 🙂

[dlanorh]

You can alway use the optional extent parameter, as in

(vlax-curve-getclosestpointto ent pt T)

[mint09]

Thanks all, its working as i needed.THANK YOU SO MUCH..

i got one more from the link it gave, ill paste it here. its from RONJONP,

(defun c:foo (/ _dxf _sl a b c e p s x)
  ;; RJP » 2019-01-10
  (defun _sl (s) (cond ((= 'pickset (type s)) (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))))
  (defun _dxf (c e) (cdr (assoc c (entget e))))
  (cond
    ((setq s (_sl (ssget)))
     (foreach x	s
       (if (wcmatch (_dxf 0 x) "CIRCLE,INSERT,POINT")
	 (setq b (cons (_dxf 10 x) b))
	 (and (= 'real (type (vl-catch-all-apply 'vlax-curve-getendparam (list x))))
	      (setq a (cons x a))
	 )
       )
     )
     (and a
	  b
	  (foreach p b
	    (setq c
		   (car	(vl-sort
			  (mapcar
			    '(lambda (x)
			       (list (setq c (vlax-curve-getclosestpointto x p)) (distance p c) (_dxf 8 x))
			     )
			    a
			  )
			  '(lambda (r j) (< (cadr r) (cadr j)))
			)
		   )
	    )
	    (setq e (entmakex (list '(0 . "line") (cons 10 p) (cons 11 (car c)) (cons 8 (caddr c)))))
	    ;; This line below creates the right example comment out to get left
	    ;; (setq a (cons e a))
	  )
     )
    )
  )
  (princ)
)

[ВeekeeCZ]

---

@mint09 wrote:

... i got one more from the link it gave, ill paste it here. its from RONJONP, ...

---

aka @ronjonp. He posted a link to his solution... 😉

[ronjonp]

---

@ВeekeeCZ wrote:

---

@mint09 wrote:

... i got one more from the link it gave, ill paste it here. its from RONJONP, ...

---

aka @ronjonp. He posted a link to his solution... 😉

---

I wish I could change my username to 'ronjonp' for consistency across the interwebs .. do you know any of the moderators / site admin that could do this for me?

[ВeekeeCZ]

I guess the best place is  HERE

Or you could hit the "Report" button and ask.

Or as we talk about it here, I would notify him @Discussion_Admin 

[Discussion_Admin]

---

@ronjonp 

Just follow the steps here and you can change it yourself.

Note you will have to log out and back in for changes to take effect.

DA

[john.uhden]

Why, thank you, Ron.

Don't know when I would use it, but I wasn't aware of that.

Learning is a wonderful thing!

[ronjonp]

---

@Discussion_Admin wrote:

---

@ronjonp 

Just follow the steps here and you can change it yourself.

Note you will have to log out and back in for changes to take effect.

DA

---

Thanks for the link! I'm going to have to wait until the system recognizes that I just removed an old personal profile that already uses the username I want to change to ..DOH!