- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello everyone.
I have some code that I am trying to modify. The original code was written by Z9E3zK5E, and I am very grateful to him for that. The code was written at my request from this thread, where I explained that I need this as a basis for adding my functions there, and Z9E3zK5E kindly provided this code.
In short, the code partially emulates the standard PLINE command by creating polylines using the GETPOINT, ENTMAKEX, and ENTMOD functions.
Now I tried to add a new "Perpendicular" option to the original code and got the problem. If select the "Perpendicular" option while creating a polyline, the code works as I need — it draws perpendicular segments of the polyline. But if you then select any other option, then the code fails. Also in the code there is one more function "Linear" which was supposed to be a trigger to exit the "Perpendicular" mode.
Below I give the code where the original code by Z9E3zK5E (thanks to him again) is formatted and my edits are highlighted in color.
Dear LISP experts, help to solve this problem.
Also.
I have another question about this code, it is not as important as the first question, but it will be great if we can solve it as well. In the current version of the code, all options are activated after three points are picked. But is it possible to make the "Perpendicular/Linear/Undo" options appear after the second point is picked, and the "Close" option is added to the previous options after the third point is picked?
Thanks in advance to everyone who wants to help me. Here's the code:
(defun c:DrawPline ( / pt px en ed done pup ang lsg prp)
(if (setq pt (getpoint "\nSpecify first point: "))
(while (not done)
(if (and en (setq ed (entget en)) (> (cdr (assoc 90 ed)) 2))
(initget "Perpendicular Linear Close Undo")
)
(setq px
(getpoint pt
(strcat "\nSpecify next point"
(if (and ed (> (cdr (assoc 90 ed)) 2))
" [Perpendicular/Linear/Undo/Close]"
""
)
": "
)
)
)
(if prp
(setq
px (inters (cadr lsg) (polar (cadr lsg) (- ang (/ pi 2)) 100) px (polar px ang 100) nil)
ed (entmod (append (subst (cons 90 (1+ (cdr (assoc 90 ed)))) (assoc 90 ed) ed) (list (cons 10 px))))
lsg (append (cdr lsg) (list px))
ang (apply 'angle lsg)
)
)
(cond
( (not px)
(setq done T)
)
( (and (listp px) (not ed))
(setq en
(entmakex
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
'(90 . 2)
'(70 . 0)
(cons 10 pt)
(cons 10 px)
)
)
)
(setq pt px)
)
( (listp px)
(setq ed
(entmod
(append
(subst
(cons 90 (1+ (cdr (assoc 90 ed))))
(assoc 90 ed) ed
)
(list (cons 10 px))
)
)
)
(setq pt px)
)
( (= px "Perpendicular")
(setq
px pt
pup (append (cadr (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq 10 (car x))) (reverse ed)))) '(0))
ang (angle px pup)
lsg (list nil px)
px (inters (cadr lsg) (polar (cadr lsg) (- ang (/ pi 2)) 100) px (polar px ang 100) nil)
ed (entmod (append (subst (cons 90 (1+ (cdr (assoc 90 ed)))) (assoc 90 ed) ed) (list (cons 10 px))))
prp t
)
)
( (= px "Linear")
(setq px pt prp nil)
)
( (= px "Undo")
(setq ed
(entmod
(append
(subst
(cons 90 (1- (cdr (assoc 90 ed))))
(assoc 90 ed)
(reverse (cdddr (cdddr (reverse ed))))
)
(list (assoc 210 ed))
)
)
)
(setq pt (cdr (assoc 10 (reverse ed))))
)
( (= px "Close")
(entmod
(append
(if (equal (assoc 10 ed) (assoc 10 (reverse ed)))
(subst
(cons 90 (1- (cdr (assoc 90 ed))))
(assoc 90 ed)
(reverse (cdddr (cdddr (reverse ed))))
)
ed
)
(list (cons 70 (1+ (cdr (assoc 70 ed)))))
(list (assoc 210 ed))
)
)
(setq done T)
)
)
)
)
(princ)
)
Solved! Go to Solution.
