Hello everyone, I was looking for a LISP that copy or multiply a polyline exactly and then connect to the specified point or pick point of block by creating a new pline. I explained with 2 PNGs, I hope you may help.
1)
2)
Accepted solution
Here is solution for Case 1
If direction of newly added polyline is to wrong direction use command REVERSE on base polyline and start again.
I'll leave case 2 to someone else since you didn't provide sufficient details.
Next time you can try to write down some code and also attach dwg sample for easier work on code. If you attach screenshots it's a plus.
(defun c:nps ( / *error* take pointlist2d adoc e eo p1 p2 d1 d2 pts i rev)
(defun *error* ( msg )
(if (not (member msg '("Function cancelled" "quit / exit abort")))
(princ)
)
(setvar 'cmdecho 1)
(princ)
)
(defun take (amount lst / ret)(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst))))))
(defun pointlist2d (lst / ret) (while lst (setq ret (cons (take 2 lst) ret) lst (cddr lst))) (reverse ret))
(setq e (car (entsel "\nSelect polyline >")))
(cond
((and e)
(setq eo (vlax-ename->vla-object e))
(cond
((= (vlax-get eo 'Objectname) "AcDbPolyline")
(setq p1 (take 2(getpoint "\nSelect point >")))
(setq p2 (take 2(vlax-curve-getClosestPointTo eo p1)))
(setvar 'cmdecho 0)
(setq d1 (vlax-curve-getdistatparam eo (vlax-curve-getParamAtPoint eo p2)))
(setq pts (pointlist2d (vlax-get eo 'Coordinates)))
(setq i 0)
(while (< (vlax-curve-getDistAtPoint eo (nth i pts)) d1) (setq i(1+ i)))
(setq pts (append (take i pts)(list p2 p1)))
(entmakex
(apply 'append
(cons
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(410 . "Model")
'(8 . "0")
'(38 . 0)
'(62 . 3)
'(67 . 0)
'(70 . 0)
(cons 90 (length pts))
)
(mapcar 'list (mapcar '(lambda (a) (cons 10 a)) pts))
)
)
)
(setvar 'cmdecho 1)
)
)
)
)
(princ)
)
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Thank you so much. That's so good but I was wondering if new pline may take all their properties from source pline?
'(8 . "0")
'(38 . 0)
'(62 . 3)
'(67 . 0)
'(70 . 0)
Also, can I use osnap on while I'm selecting my pick point? That would be important for me while merging blocks and plines. Plus, while merging further point, can we use x,y coordinates and 90 degrees instead of hypotenuse as you can see in PNG (alternative section, in bottom)?
Accepted solution
Here is updated code for case 1
(defun c:nps ( / *error* take pointlist2d adoc e eo fo p1 p2 d1 d2 pts i rev)
(defun *error* ( msg )
(if (not (member msg '("Function cancelled" "quit / exit abort")))
(princ)
)
(setvar 'cmdecho 1)
(princ)
)
(defun take (amount lst / ret)(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst))))))
(defun pointlist2d (lst / ret) (while lst (setq ret (cons (take 2 lst) ret) lst (cddr lst))) (reverse ret))
(setq e (car (entsel "\nSelect polyline >")))
(cond
((and e)
(setq eo (vlax-ename->vla-object e))
(cond
((= (vlax-get eo 'Objectname) "AcDbPolyline")
(setvar 'cmdecho 0)
(command "_.copy" e "" "_none" '(0 0 0) "_none" '(0 0 0))
(setq fo (vlax-ename->vla-object (entlast)))
(setq p1 (take 2(getpoint "\nSelect point >")))
(setq p2 (take 2(vlax-curve-getClosestPointTo eo p1)))
(setq d1 (vlax-curve-getdistatparam eo (vlax-curve-getParamAtPoint eo p2)))
(setq pts (pointlist2d (vlax-get eo 'Coordinates)))
(setq i 0)
(while (< (vlax-curve-getDistAtPoint eo (nth i pts)) d1) (setq i(1+ i)))
(setq pts (append (take i pts)(list p2 p1)))
(vlax-put fo 'Coordinates (apply 'append pts))
(setvar 'cmdecho 1)
)
)
)
)
(princ "\nDone1")
(princ)
)
Problem is not as simple as it looks, since drawing direction of base polyline affects how code works. For case 1 this can be solved by reverting polyline. For case 2 this won't work. Also I suppose you are not working only along x axis.
If I find some time to work on this I'll try to make some code that joins case 1 and 2.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
