Help in lisp please

Help in lisp please

onlineoffers1988
Contributor Contributor
5,347 Views
61 Replies
Message 1 of 62

Help in lisp please

onlineoffers1988
Contributor
Contributor

hello

i want help for creating lisp for me please ... the lisp will do these functions

1- as the attached image if i have block with yellow at right and some green blocks 1a.png

2- i want when i launch the lisp to ask me to draw poly line that i want as in image 2

2a.png

3- after that when i draw this path with polyline and press enter the lisp ask me to choose blocks that i want to connect to this polyline and i will choose one by one or multiple blocks then after choosing the blocks and press enter ... the lisp will offset the main polyline that i draw and connect every polyline with the basepoint of the blocks that i choose sequentially as appear in this image (attached DWG)

5a.png

can anyone help me please

0 Likes
Accepted solutions (3)
5,348 Views
61 Replies
Replies (61)
Message 61 of 62

Gobel_A
Enthusiast
Enthusiast

I got it.. And works with this part of code instead od "getpropertyvalue"

 

(/ (vlax-get-property (vlax-ename->vla-object e) 'Length) 2))))
0 Likes
Message 62 of 62

Gobel_A
Enthusiast
Enthusiast

With the help of AI i added the function for user defined offset between lines with handling with zero as input (will be replaced with 0.0001 offset)

(vl-load-com)
;; beekeecz 22-11-24

(defun c:Wiring ( / d *error* doc :plfillet :pltrimadd s e p o so s+ s- f r i)
  
  ; Initialize the distance value (use the last value if available)
  (if (setq d (or d 30.))
    (setq d (getcustomdist d))
  )

  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if doc (vla-endundomark doc))
    (princ))
  
  (defun :plfillet (ent par rad / tan enx v1 v2 v3 a1 a2 p1 p2 p3 ) ;; Lee Mac, mods
    (defun tan (x) (if (not (equal 0.0 (cos x) 1e-10)) (/ (sin x) (cos x)))) ;; Lee Mac
    (if (and (setq v1 (vlax-curve-getpointatparam ent (1- par)))
	     (setq v2 (vlax-curve-getpointatparam ent par))
	     (setq v3 (vlax-curve-getpointatparam ent (1+ par)))
	     (setq a1 (angle v2 v1)
		   a2 (angle v2 v3)
		   p1 (polar v2 a1 rad)
		   p2 (polar v2 a2 rad)
		   p3 (inters p1 (polar p1 (+ a1 (/ pi 2)) 1) p2 (polar p2 (+ a2 (/ pi 2)) 1) nil)
		   enx (entget ent)
		   v2 (list 10 (car v2) (cadr v2))
		   v3 (list 10 (car v3) (cadr v3))))
      (entmod (setq enx (append (reverse (cdr (vl-member-if '(lambda (x) (equal x v2 1e-6)) (reverse enx))))
				(list (cons 10 p1) (cons 42 (tan (/ (- pi (abs (- a1 a2))) (if (minusp (- a1 a2)) -4. 4.))))
				      (cons 10 p2))
				(vl-member-if '(lambda (x) (equal x v3 1e-6)) enx))
		    enx (subst (cons 90 (1+ (cdr (assoc 90 enx)))) (assoc 90 enx) enx)))))

  (defun :pltrimadd (ent add / enx brk)
    (entmod (setq brk (cons 10 (reverse (cdr (reverse (vlax-curve-getpointatparam ent (1+ (fix (vlax-curve-getparamatpoint ent (car add)))))))))
		  enx (append (reverse (cdr (vl-member-if '(lambda (x) (equal x brk 1e-6)) (reverse (entget ent)))))
			      (mapcar '(lambda (x) (cons 10 x)) add))
		  enx (subst (cons 90 (length (vl-remove-if '(lambda (x) (/= 10 (car x))) enx))) (assoc 90 enx) enx))))
  
  ; =============================================================================================================================================
  
  (if (and (setq s (ssget "_:L" '((0 . "INSERT"))))
	   (mapcar 'set '(e p) (entsel "\nSelect polyline at start: "))
	   (or (= "LWPOLYLINE" (cdr (assoc 0 (entget e))))
	       (alert "Error: Selected object is not a lwpolyline!"))
	   (not (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object)))))
	   (cond ((minusp (- (vlax-curve-getdistatpoint e (vlax-curve-getclosestpointto e (trans p 1 0))) (/ (vlax-get-property (vlax-ename->vla-object e) 'Length) 2))))
		 ((vl-cmdf "_.reverse" e "")))
	   
	   (setq o (vlax-ename->vla-object e))
	   (vla-offset o d)
	   (setq f (entlast))

	   (setq s (vl-remove-if 'listp (mapcar 'cadr (ssnamex s))))
	   (setq s (mapcar '(lambda (x) (list (vlax-curve-getclosestpointto e (setq p (reverse (cdr (reverse (cdr (assoc 10 (entget x)))))))) p)) s))
	   (setq s (vl-sort s '(lambda (x1 x2) (> (vlax-curve-getdistatpoint e (car x1)) (vlax-curve-getdistatpoint e (car x2))))))
	   
	   (setq so (list (car s)))
	   (or (not (cdr s))
	       (foreach x (cdr s)
		 (if (< (distance (last x) (vlax-curve-getclosestpointto f (last x))) (distance (car x) (last x)))
		   (setq s+ (cons x s+))
		   (setq s- (cons x s-)))))
	   (entdel f)
	   )
    
    (foreach w (list (list 1 s+) (list -1 s-) (list 0 so))
      (setq i 0)
      (foreach p (mapcar 'last (reverse (cadr w)))
	(and (if (zerop (car w))
	       (setq n e)
	       (and (vla-offset o (* (setq i (+ i (car w))) d))
		    (setq n (entlast))))
	     (setq c (vlax-curve-getclosestpointto n p))
	     (setq x (if (or (not (setq r (vlax-curve-getFirstDeriv e (1- (vlax-curve-getparamatpoint n c)))))
			     (equal (car c) (car p) 1e-6)
			     (equal (cadr c) (cadr p) 1e-6))
		       (list c p)
		       (list c (if (equal 0 (cadr r) 1e-6) (list (car p) (cadr c)) (list (car c) (cadr p))) p)))
	     (:pltrimadd n x)
	     (:plfillet n (1- (vlax-curve-getendparam n)) d)
	     ))))
  
  (setq d (getcustomdist d)) ; Prompt the user for a new distance and store it
  
  (*error* "end")
  )

(defun getcustomdist (default)
  (setq dist default)
  (setq dist (getreal (strcat "\nEnter the new distance value (current value is " (if (and (numberp dist) (not (= dist 0.0))) (rtos dist 2 2) "") "): ")))
  (if (and (numberp dist) (<= (abs dist) 0.0001)) ; Check if dist is a number and close to zero
    0.0001
    (if (and (numberp dist) (not (= dist 0.0))) ; Check if dist is a number and not zero
      dist
      default
    )
  )
)
0 Likes