[Lisp] Need help with "hard" lisp

May 12, 2016

Hi,

I need help with lisp routine.

To understand what i would like to achieve, please download attached dwg file.

Let's start.

My finally goal is to get list that will contain following data

((1 17.7656) (2 36.4474) (3 26.4085) (5 59,6297) .... (12 39.9307) ("last" 35.9001))

Where

1 - is attribute value of first block starting from begining of pline

17.7656 - is distance between first vertex of pline and first found block, distance is measured along pline

2 - is value of next attribute in block

36.4474 - is distance between first and second block

5 - as above

59,6297- as above

...

last - is string

35.9001 distace between last selected block and end of pline.

Distances should be measured through pline (propably using vlax-curve-getDistAtPoint) arguments for vlax-curve-getDistAtPoint maybe should be given by function vlax-curve-getClosestPointTo, but that are only my ideas.

First question, how to ssget all blocks (named "Block" in attachet dwg file) whose insertion point are in distance smaller or equal to 15 (in this example but that can be another distance) from my polyline.

Thanks for any help.

example.dwg

May 13, 2016

Here is a start for you you need to use the insert point of the block as PT I am working on something else and will post code for that hopefully in next couple of days.

http://www.cadtutor.net/forum/showthread.php?96642-Reference-a-block-to-road-alignment

May 13, 2016

Thanks for reply BIGAL!

Here is a start for you you need to use the insert point of the block as PT I am working on something else and will post code for that hopefully in next couple of days.

http://www.cadtutor.net/forum/showth...road-alignment

I also found this useful thread:

http://www.cadtutor.net/forum/showthread.php?30556-Create-Perpendicular-Line-at-every-intersection-point

Below is beging of my coding.

My first question solved - i have list of blocks entity names which insertion point are in distance smaller or equal to given distance.

It's time for second question... How to get my final list ?

I will come back to this on monday.

In the meantime, if someone could give me opinion about first part I will be grateful!

Also please explain to me how works function getPerpendicularPoint, becouse i modified getClosestPointTo function from this post and it works, but I don't underestend everything.

(vl-load-com)
;;v2016-05-13
;;ziele_o2k
;;Main function
(defun c:teee ( / EntPline BlocksSS DistForFilterSS BlkEntLst)
(if
	(and
		(setq
			EntPline (car (entsel "\nSelect Main Pline > "));select main pline
			BlocksSS (ssget '((0 . "INSERT") (2 . "BLOCK") (66 . 1)));ssget blocks
			DistForFilterSS (getreal "\nType offset distance to filter blocks > ");get distance for 
		)
		(member (cdr (assoc 0 (entget EntPline))) '("POLYLINE" "LWPOLYLINE"))
		(setq BlkEntLst (PZ:FilterSS EntPline BlocksSS DistForFilterSS))
	)
	(print BlkEntLst)
	(print "No blocks")
)
(princ)
)
;;Function to filter ssget. Returns list of entity names that are perpendicular
;;to selected center, main pline, else nil
(defun PZ:FilterSS (MainPline BlkSS dist / TmpEnts in BlkPt PerpBlkLst)
(setq 
	TmpEnts
	(mapcar
		'vlax-vla-object->ename
		(vlax-invoke (vlax-ename->vla-object MainPline) 'Explode)
	)
)
(repeat (setq in (sslength BlkSS))
	(setq BlkPt (cdr (assoc 10 (entget (ssname BlkSS (setq in (1- in)))))))
	(if 
		(and 
			(getPerpendicularPoint TmpEnts BlkPt)
			(<= (distance (getPerpendicularPoint TmpEnts BlkPt) BlkPt) dist)
		)
		(setq PerpBlkLst (cons (ssname BlkSS in) PerpBlkLst))
		nil
	)
)
(mapcar '(lambda (x) (vla-delete (vlax-ename->vla-object x))) TmpEnts) ; remove the segments
PerpBlkLst
)
;; modified function from this CAB post
;;http://www.cadtutor.net/forum/showthread.php?30556-Create-Perpendicular-Line-at-every-intersection-point&p=204357&viewfull=1#post204357
(defun getPerpendicularPoint (Ents pt / ent clspt endpts perpts result dist)
(foreach ent Ents
   (if 
		(or 
			(< (distance (setq clspt (vlax-curve-getclosestpointto ent pt)) (vlax-curve-getstartpoint ent)) 0.0001)
			(< (distance clspt (vlax-curve-getendpoint ent)) 0.0001)
		)
		nil
     (setq perpts (cons clspt perpts)) ; else got a perpendicular point
   )
 )
(setq 
	perpts
	(mapcar 
		'(lambda(x / tmp) 
			(cond
				((null dist)(setq dist (distance pt x) result x))
				((< (setq tmp (distance pt x)) dist)
																	 (setq dist tmp result x))
			)
		)
		perpts
	)
)
result
)

May 14, 2016

The perpendicular pt is basically where a circle would touch a line. The radius being the offset distance and the point intersection of the circle and line etc.

May 14, 2016

Hi,

Just finished this program so try it and let me know how you get on with the codes.

(defun c:test  (/ ss pl ds d lst l srt _att fnl fl out)
 ;; Tharwat - Date: 14.May.2016 ;;
 (cond
   ((not (setq ss (ssget "_X"
                         (list '(0 . "INSERT")
                               '(2 . "Block")
                               (cons 410 (getvar 'ctab))))))
    (princ
      "\nCould not find any block named <Block> in this drawing !"))
   ((not (and (princ "\nPick a LWpolyline:")
              (setq pl (ssget "_+.:S:E" '((0 . "LWPOLYLINE"))))
              ))
    (princ "\nMissed. Try again"))
   ((setq
      ds (getdist
           "\nSpecify gap distance between Polyline and blocks :"))
    ((lambda (i / sn pt cl)
       (while (setq sn (ssname ss (setq i (1+ i))))
         (setq pt (trans (cdr (assoc 10 (entget sn))) 1 0)
               cl (vlax-curve-getclosestpointto (ssname pl 0) pt)
               )
         (if (<= (distance pt cl) ds)
           (setq lst (cons (list sn pt cl) lst))
           )
         )
       )
      -1)
    (if lst
      (progn
        (mapcar '(lambda (x)
                   (setq
                     l (cons (list (vlax-curve-getdistatpoint
                                     (ssname pl 0)
                                     (caddr x))
                                   (car x))
                             l)))
                lst
                )
        (setq srt (vl-sort l '(lambda (j k) (< (car j) (car k)))))
        (defun _att  (e)
          (read (vla-get-textstring
                  (car (vlax-invoke
                         (vlax-ename->vla-object e)
                         'getattributes))))
          )
        (mapcar '(lambda (x)
                   (if d
                     (setq fnl (cons (list (_att (cadr x)) (- (car x) d))
                                     fnl)
                           d   (car x)
                           )
                     (setq d   (car x)
                           fnl (cons (list (_att (cadr x)) d) fnl)
                           )
                     ))
                srt)
        (setq fl  (list "last" (cadar fnl))
              out (cons fl (cdr fnl))
              )
        )
      )))
 (if out
   (reverse out)
   (princ))
 )(vl-load-com)

May 17, 2016

Hi,

Just finished this program so try it and let me know how you get on with the codes.

Thank you for your code. It was good but had some bugs.

I wrote my own (based on Tharwat code:)), and it works fine for me.

(vl-load-com)
;;v2016-05-17
;;ziele_o2k
;;Main function
(defun c:te2 ( / ss pl ds lst1 sl lst2 lst3 srt out)
 (cond
   ( 
     (not (setq ss (ssget "_X" (list '(0 . "INSERT") '(2 . "Block") (cons 410 (getvar 'ctab))))))
     (princ "\nCould not find any block named <Block> in this drawing !")
   );selecting all blocks in drawing
   (
     (not (and (princ "\nPick a LWpolyline:")(setq pl (ssget "_+.:S:E" '((0 . "LWPOLYLINE"))))))
     (princ "\nMissed. Try again")
   );get main pline
   (
     (setq ds (getdist "\nSpecify gap distance between Polyline and blocks :"));set distance to filter blocks
     (
       (lambda (i / sn pt cl)
         (while (setq sn (ssname ss (setq i (1+ i))))
           (setq 
             pt (trans (cdr (assoc 10 (entget sn))) 1 0);pt block base point in WCS
             cl (vlax-curve-getclosestpointto (ssname pl 0) pt);coordinates of point on curve (in WCS) which is nearest to curve
           )
           (if 
             (<= (distance pt cl) ds);filter blocks from ss which are in smaller or eqal distance to given distace
             (setq lst1 (cons (list sn pt cl) lst1));make list with ename of block, base point of block and point on curve
           )
         )
       )
      -1
     )
     (if lst1
       (progn
         (setq sl (PZ:getPolySegs (ssname pl 0)))
         (foreach %1 lst1
           (
             (lambda (%2 / )
               (cond
                 (
                   (= (vlax-curve-getParamAtPoint (ssname pl 0) (caddr %2))(vlax-curve-getStartParam(ssname pl 0)))
                   (if 
                     (PZ:IsPerpendicular 
                       (vlax-curve-getPointAtParam (ssname pl 0) (vlax-curve-getStartParam(ssname pl 0)))
                       (vlax-curve-getPointAtParam (ssname pl 0) (1+ (vlax-curve-getStartParam(ssname pl 0))))
                       (cadr %2)
                       (caddr %2)
                       (cadar sl)
                     )
                     (setq lst2 (cons %2 lst2))
                   )
                 )
                 (
                   (= (vlax-curve-getParamAtPoint (ssname pl 0) (caddr %2))(vlax-curve-getEndParam(ssname pl 0)))
                   (if 
                     (PZ:IsPerpendicular 
                       (vlax-curve-getPointAtParam (ssname pl 0) (vlax-curve-getEndParam(ssname pl 0)))
                       (vlax-curve-getPointAtParam (ssname pl 0) (1- (vlax-curve-getEndParam(ssname pl 0))))
                       (cadr %2)
                       (caddr %2)
                       (cadr (last sl))
                     )
                     (setq lst2 (cons %2 lst2))
                   )
                 )
                 (T (setq lst2 (cons %2 lst2)))
               )
             )
             %1
           )
         )
         (if lst2
           (progn
             (mapcar
               '(lambda (%1)
                 (setq lst3 (cons (list (vlax-curve-getdistatpoint(ssname pl 0)(caddr %1))(car %1))lst3))
               )
               lst2
             ) 
             (setq srt (vl-sort lst3 '(lambda (j k) (< (car j) (car k)))))
             (defun _att (e)
               (read 
                 (vla-get-textstring
                   (car (vlax-invoke (vlax-ename->vla-object e) 'getattributes))
                 )
               )
             )
             (mapcar
               '(lambda (%)
                 (setq 
                   out 
                   (cons 
                     (list  
                       (_att (cadr %)) (car %) (- (PZ:GetCurveLength (ssname pl 0)) (car %))
                     )
                     out
                   )
                 )
               )
               srt
             )
           )
         )
       )
     )
     
   )
 )
(if out
	(setq out (reverse out))
	(princ)
)
(terpri)
 (princ out)
 (princ)
)
;http://www.cadtutor.net/forum/archive/index.php/t-60816.html?
(defun LM:Roundto ( n p / f )
(setq n (- n (setq f (rem n (setq p (expt 10. (- p)))))))
(if (< 0.5 (/ (abs f) p))
((if (minusp n) - +) n p)
n
)
)
;modified from
;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-polyline-length/td-p/817505
(defun PZ:GetCurveLength (curve / )
 (vl-load-com)
 (vlax-curve-getDistAtParam curve
   (vlax-curve-getEndParam curve)
 )
)
;verify if segment is perpendicular to pline segment
;segment is given by p3 and p4
;pline segment is given by p1 p2 and b
;if b is not equal 0 then given segment is arc
(defun PZ:IsPerpendicular (p1 p2 p3 p4 b / xu xv yu yv )
 (if (not (eq b 0))
	(setq 
		p1 p4
		p2 (LM:bulgecentre p1 p2 b)
	)
)
 (foreach n (list p1 p2 p3 p4) (print n))
(setq 
   xu (- (car p2) (car p1))
   yu (- (cadr p2) (cadr p1))
   xv (- (car p4) (car p3))
   yv (- (cadr p4) (cadr p3))
 )

 (if (eq b 0)
   (cond
     ((eq(LM:Roundto(+ (* xu xv) (* yu yv))6)0) (print "perp")T)
     (T  (print "notperp") nil)
   );condition for perpendicular
   (cond
     ((eq(LM:Roundto(- (* xu yv) (* xv yu))6)0)(print "parall")T)
     (T (print "notparall")nil)
   );condition for parallel
 )
)
;modified lisp from
;http://www.lee-mac.com/lisp/html/PolyInfoV1-3.html
;; Bulge Centre  -  Lee Mac
;; p1 - start vertex
;; p2 - end vertex
;; b  - bulge
;; Returns the centre of the arc described by the given bulge and vertices
(defun LM:bulgecentre ( p1 p2 b )
 (polar p1
   (+ (angle p1 p2) (- (/ pi 2) (* 2 (atan b))))
   (/ (* (distance p1 p2) (1+ (* b b))) 4 b)
 )
)
;modified lisp from
;http://www.afralisp.net/autolisp/tutorials/polyline-bulges-part-1.php
(defun PZ:getPolySegs (ent / entl p1 pt bulge seg ptlst)
 (cond (ent
			(setq entl (entget ent))
        ;; save start point if polyline is closed
        (if (= (logand (cdr (assoc 70 entl)) 1) 1)
          (setq p1 (cdr (assoc 10 entl)))
        )
        ;; run thru entity list to collect list of segments
        (while (setq entl (member (assoc 10 entl) entl))
          ;; if segment then add to list
          (if (and pt bulge)
            (setq seg (list pt bulge))
          )
          ;; save next point and bulge
          (setq pt    (cdr (assoc 10 entl))
                bulge (cdr (assoc 42 entl))
          )
          ;; if segment is build then add last point to segment
          ;; and add segment to list
          (if seg
            (setq seg (append seg (list pt))
                  ptlst (cons seg ptlst))
          )
          ;; reduce list and clear temporary segment
          (setq entl  (cdr entl)
                seg   nil
          )
        )
       )
 )
 ;; if polyline is closed then add closing segment to list
 (if p1 (setq ptlst (cons (list pt bulge p1) ptlst)))
 ;; reverse and return list of segments
 (reverse ptlst)
)

All comments to my code are welcome!

May 17, 2016

First of all You don't have the right to remove my name from my codes.

Secondly, my routine does EXACTLY the list you have posted into your first post and ( your codes ) does / print a completely different list.

So you should not have said BUGS but your mistake that you did not describe your needs very clearly.

May 17, 2016

First of all You don't have the right to remove my name from my codes.

First of all - I'm sorry Mr., for removeing your name from your code.

Secondly, my routine does EXACTLY the list you have posted into your first post and ( your codes ) does / print a completely different list.

And yes, your code have some bugs which i found during testing.

1) First:

Try your code with attached file example_v1.dwg. Your lisp returnes following list (for gap distance equal to 15):

((99 0.0) (1 17.7656) (2 36.4474) (3 26.4085) (5 59.6297) (7 62.222) (8 24.0023) (10 64.0678) (11 21.0495) (12 39.9307) ("last" 35.9001)) ((99 0.0) (1 17.7656) (2 36.4474) (3 26.4085) (5 59.6297) (7 62.222) (8 24.0023) (10 64.0678) (11 21.0495) (12 39.9307) ("last" 35.9001))

I don't want first element: (99 0.0). This bug was not claryfied in my first post but i didn't want to waste your time so I fixed it in my modifications.

2) Second:

Try your lisp with file example_v2.dwg - if this is not bug then I dont know what is.

So you should not have said BUGS but your mistake that you did not describe your needs very clearly.

You wrote good lisp with small bugs, and it was close to what i asked in first post. While I was wraiting my modifications I had changed concept of this function so it's my fault, that i didn't mentioned about that when I was publishing my modifications.

But enough of this, your code Tharwat was very helpfull and without it I would have big problems to achive my goal

BTW final code:

(vl-load-com)
;; Tharwat - Date: 14.May.2016 ;;
;;http://www.cadtutor.net/forum/showthread.php?96830-Lisp-Need-help-with-quot-hard-quot-lisp&p=661545&viewfull=1#post661545
;;with modifications by
;;ziele_o2k
;;v2016-05-17
;;Main function
(defun c:te2 ( / ss pl ds lst1 sl lst2 lst3 srt out)
 (cond
   ( 
     (not (setq ss (ssget "_X" (list '(0 . "INSERT") '(2 . "Block") (cons 410 (getvar 'ctab))))))
     (princ "\nCould not find any block named <Block> in this drawing !")
   );selecting all blocks in drawing
   (
     (not (and (princ "\nPick a LWpolyline:")(setq pl (ssget "_+.:S:E" '((0 . "LWPOLYLINE"))))))
     (princ "\nMissed. Try again")
   );get main pline
   (
     (setq ds (getdist "\nSpecify gap distance between Polyline and blocks :"));set distance to filter blocks
     (
       (lambda (i / sn pt cl)
         (while (setq sn (ssname ss (setq i (1+ i))))
           (setq 
             ;pt (trans (cdr (assoc 10 (entget sn))) sn 0);pt block base point in WCS 77.0638,456.843,0.0 741.813,-41.2691,0.0 77.0638,456.843,0.0
       pt (trans (cdr (assoc 10 (entget sn))) sn 0)
             cl (vlax-curve-getclosestpointto (ssname pl 0) pt);coordinates of point on curve (in WCS) which is nearest to curve
           )
					(if 
             (<= (distance pt cl) ds);filter blocks from ss which are in smaller or eqal distance to given distace
             (setq lst1 (cons (list sn pt cl) lst1));make list with ename of block, base point of block and point on curve
           )
         )
       )
      -1
     )
		(print lst1)
     (if lst1
       (progn
         (setq sl (PZ:getPolySegs (ssname pl 0)))
         (foreach %1 lst1
           (
             (lambda (%2 / )
               (cond
                 (
                   (= (vlax-curve-getParamAtPoint (ssname pl 0) (caddr %2))(vlax-curve-getStartParam(ssname pl 0)))
                   (if 
                     (PZ:IsPerpendicular 
                       (vlax-curve-getPointAtParam (ssname pl 0) (vlax-curve-getStartParam(ssname pl 0)))
                       (vlax-curve-getPointAtParam (ssname pl 0) (1+ (vlax-curve-getStartParam(ssname pl 0))))
                       (cadr %2)
                       (caddr %2)
                       (cadar sl)
                     )
                     (setq lst2 (cons %2 lst2))
                   )
                 )
                 (
                   (= (vlax-curve-getParamAtPoint (ssname pl 0) (caddr %2))(vlax-curve-getEndParam(ssname pl 0)))
                   (if 
                     (PZ:IsPerpendicular 
                       (vlax-curve-getPointAtParam (ssname pl 0) (vlax-curve-getEndParam(ssname pl 0)))
                       (vlax-curve-getPointAtParam (ssname pl 0) (1- (vlax-curve-getEndParam(ssname pl 0))))
                       (cadr %2)
                       (caddr %2)
                       (cadr (last sl))
                     )
                     (setq lst2 (cons %2 lst2))
                   )
                 )
                 (T (setq lst2 (cons %2 lst2)))
               )
             )
             %1
           )
         )
         (if lst2
           (progn
             (mapcar
               '(lambda (%1)
                 (setq lst3 (cons (list (vlax-curve-getdistatpoint(ssname pl 0)(caddr %1))(car %1))lst3))
               )
               lst2
             ) 
             (setq srt (vl-sort lst3 '(lambda (j k) (< (car j) (car k)))))
             (defun _att (e)
               (read 
                 (vla-get-textstring
                   (car (vlax-invoke (vlax-ename->vla-object e) 'getattributes))
                 )
               )
             )
             (mapcar
               '(lambda (%)
                 (setq 
                   out 
                   (cons 
                     (list  
                       (_att (cadr %)) (car %) (- (PZ:GetCurveLength (ssname pl 0)) (car %))
                     )
                     out
                   )
                 )
               )
               srt
             )
           )
         )
       )
     )
     
   )
 )
(if out
	(setq out (reverse out))
	(princ)
)
(terpri)
 (princ out)
 (princ)
)

;(vlax-curve-getclosestpointto (car (entsel)) (getpoint "/npick point: "))

;http://www.cadtutor.net/forum/archive/index.php/t-60816.html?
(defun LM:Roundto ( n p / f )
(setq n (- n (setq f (rem n (setq p (expt 10. (- p)))))))
(if (< 0.5 (/ (abs f) p))
((if (minusp n) - +) n p)
n
)
)
;modified from
;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/get-polyline-length/td-p/817505
(defun PZ:GetCurveLength (curve / )
 (vl-load-com)
 (vlax-curve-getDistAtParam curve
   (vlax-curve-getEndParam curve)
 )
)
;verify if segment is perpendicular to pline segment
;segment is given by p3 and p4
;pline segment is given by p1 p2 and b
;if b is not equal 0 then given segment is arc
(defun PZ:IsPerpendicular (p1 p2 p3 p4 b / xu xv yu yv )
 (if (not (eq b 0))
	(setq 
		p1 p4
		p2 (LM:bulgecentre p1 p2 b)
	)
)
 (foreach n (list p1 p2 p3 p4) (print n))
(setq 
   xu (- (car p2) (car p1))
   yu (- (cadr p2) (cadr p1))
   xv (- (car p4) (car p3))
   yv (- (cadr p4) (cadr p3))
 )

 (if (eq b 0)
   (cond
     ((eq(LM:Roundto(+ (* xu xv) (* yu yv))6)0) (print "perp")T)
     (T  (print "notperp") nil)
   );condition for perpendicular
   (cond
     ((eq(LM:Roundto(- (* xu yv) (* xv yu))6)0)(print "parall")T)
     (T (print "notparall")nil)
   );condition for parallel
 )
)
;modified lisp from
;http://www.lee-mac.com/lisp/html/PolyInfoV1-3.html
;; Bulge Centre  -  Lee Mac
;; p1 - start vertex
;; p2 - end vertex
;; b  - bulge
;; Returns the centre of the arc described by the given bulge and vertices
(defun LM:bulgecentre ( p1 p2 b )
 (polar p1
   (+ (angle p1 p2) (- (/ pi 2) (* 2 (atan b))))
   (/ (* (distance p1 p2) (1+ (* b b))) 4 b)
 )
)
;modified lisp from
;http://www.afralisp.net/autolisp/tutorials/polyline-bulges-part-1.php
(defun PZ:getPolySegs (ent / entl p1 pt bulge seg ptlst)
 (cond (ent
			(setq entl (entget ent))
        ;; save start point if polyline is closed
        (if (= (logand (cdr (assoc 70 entl)) 1) 1)
          (setq p1 (cdr (assoc 10 entl)))
        )
        ;; run thru entity list to collect list of segments
        (while (setq entl (member (assoc 10 entl) entl))
          ;; if segment then add to list
          (if (and pt bulge)
            (setq seg (list pt bulge))
          )
          ;; save next point and bulge
          (setq pt    (cdr (assoc 10 entl))
                bulge (cdr (assoc 42 entl))
          )
          ;; if segment is build then add last point to segment
          ;; and add segment to list
          (if seg
            (setq seg (append seg (list pt))
                  ptlst (cons seg ptlst))
          )
          ;; reduce list and clear temporary segment
          (setq entl  (cdr entl)
                seg   nil
          )
        )
       )
 )
 ;; if polyline is closed then add closing segment to list
 (if p1 (setq ptlst (cons (list pt bulge p1) ptlst)))
 ;; reverse and return list of segments
 (reverse ptlst)
)

----

Edit 17.05.2016 - changed pt variable definition in final code

example_v1.dwg

example_v2.dwg

Edited May 17, 2016 by ziele_o2k

May 17, 2016

Never mind, thanks for clarifying the issue for the public.

May 22, 2016

Hi,

I have just took a look at the codes again and I think you don't need more than the following modification if I got your point correctly from your attached two drawings.

Try it and let me know:

(defun c:test (/ ss pl ds d lst l srt _att fnl out)
 ;; Tharwat - Date: 22.May.2016 ;;
 (cond
   ((not (setq ss (ssget "_X" (list '(0 . "INSERT")
                                    '(2 . "Block")
                                    (cons 410 (getvar 'ctab))
                               )
                         )
               )
         )
    (princ "\nCould not find any block named <Block> in this drawing !")
    )
   ((not (and (princ "\nPick a LWpolyline:")
              (setq pl (ssget "_+.:S:E" '((0 . "LWPOLYLINE"))))
              )
         )
    (princ "\nMissed. Try again")
    )
   ((setq ds (getdist "\nSpecify gap distance between Polyline and blocks :" ))
    ((lambda (i / sn pt cl)
       (while (setq sn (ssname ss (setq i (1+ i))))
         (setq pt (cdr (assoc 10 (entget sn))) 
               cl (vlax-curve-getclosestpointto (ssname pl 0) pt)
               )
         (if (<= (distance pt cl) ds)
           (setq lst (cons (list sn pt cl) lst))
           )
         )
       )
      -1
      )
    (if lst
      (progn
        (mapcar '(lambda (x)
                   (setq l (cons (list (vlax-curve-getdistatpoint
                                         (ssname pl 0)
                                         (caddr x)
                                         )
                                   (car x)
                                   )
                             l
                             )
                     )
                   )
                lst
                )
        (setq srt (vl-remove-if
                    '(lambda (x) (eq (car x) 0.0))
                    (vl-sort l '(lambda (j k) (< (car j) (car k))))
                    )
              )
        (defun _att (e)
          (read (vla-get-textstring
                  (car (vlax-invoke
                         (vlax-ename->vla-object e)
                         'getattributes
                         )
                       )
                  )
                )
          )
        (mapcar '(lambda (x)
                   (if d
                     (setq fnl (cons (list (_att (cadr x)) (- (car x) d))
                                     fnl
                                     )
                           d   (car x)
                           )
                     (setq d   (car x)
                           fnl (cons (list (_att (cadr x)) d) fnl)
                           )
                     )
                   )
                srt
                )
        (setq out (cons (list "last" (cadar fnl)) (cdr fnl))
              )
        )
      )
    )
   )
 (if out (reverse out)
   (princ)
   )
 )(vl-load-com)

May 26, 2016

Have you had the chance to try the last codes I posted above?

Sign In

[Lisp] Need help with "hard" lisp

Recommended Posts

ziele_o2k

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

ziele_o2k

Link to comment

Share on other sites

BIGAL

Link to comment

Share on other sites

Tharwat

Link to comment

Share on other sites

ziele_o2k

Link to comment

Share on other sites

Tharwat

Link to comment

Share on other sites

ziele_o2k

Link to comment

Share on other sites

Tharwat

Link to comment

Share on other sites

Tharwat

Link to comment

Share on other sites

Tharwat

Link to comment

Share on other sites

Join the conversation

Tutorials

Forums

Activity