WHAT IS THE PROBLEM OF THIS LISP, WHY IT DOES NOT SELECT THE OBJECT AND NOT DIV

WHAT IS THE PROBLEM OF THIS LISP, WHY IT DOES NOT SELECT THE OBJECT AND NOT DIV

rolisonfelipe
Collaborator Collaborator
1,225 Views
2 Replies
Message 1 of 3

WHAT IS THE PROBLEM OF THIS LISP, WHY IT DOES NOT SELECT THE OBJECT AND NOT DIV

rolisonfelipe
Collaborator
Collaborator

;;;DIVAREA.LSP Land division utility
;;; written by Yorgos Angelopoulos
;;; aggior@panafonet.gr
;;;
;;; Suppose that you have to split a big part into 2, 3, 4 (or even 5.014!)
;;; or you want to cut a part of 2345 m2 out of the big one.
;;;
;;; All you need is a CLOSED LWPOLYLINE enclosing the big part.
;;;
;;; Load the utility, after placing it into an appropriate folder,
;;; let's say \Program Files\Acad2000\Support, invoke "APPLOAD" command
;;; or invoke (LOAD"DIVAREA") and run it by typing DIVAREA.
;;;
;;; Answer the few questions you will be asked and REMEMBER:
;;;
;;; When you are prompted to indicate the two points of
;;; the approximate division line, please bear in mind that
;;;
;;; 1. This DIVISION LINE will be rotated (or be offseted) and
;;; neither of its endpoints should reside outside of the boundary,
;;; (although it should have been easy to overcome this bug),
;;; so pick points as FAR OUT from the boundary as possible,
;;; not exceeding, of course, your current visibe area.
;;; As for the FIXED POINT, in case you prefer "F"
;;; rather than "C" as an answer in the previous question, it has to
;;; reside on the lwpoly or outside of it, never inside.
;;;
;;; 2. When indicating point into the part which will obtain the desired
;;; area, you have to indicate INTO it and AS FAR from division line as
;;; possible, so this point will not be outside of the desired part
;;; while the division line is moving into it.
;;;
;;; 3. Finally, you have to indicate exactly by the same way,
;;; FAR FROM DIVISION line and INTO the remaining piece.

;;; If you prefer more precision you can decrease local vars step2
;;; and step1 accordingly.
;;;
;;;******************UTILITY STARTS HERE*******************************
(defun prerr (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
);endif
(setq *error* olderr)
(princ)
);close defun
(Defun C:DIVAREA(/ osm strpf strdc ex arxset arx arxon k scl ok
d p1 p2 pts ptb deln ar par tem
stp stp1 stp2
)
(setq olderr *error*
*error* prerr)
(setq osm(getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setq ex 0
stp 0.01
stp1 0.005
stp2 0.0005
)
(setq arxset (entsel "\nSelect closed LWPOLY to divide: ")
arx (entget(car arxset))
arxon (cdr (assoc -1 arx))
)
(if (not(and(equal (cdr(assoc 0 arx)) "LWPOLYLINE") (= (cdr(assoc 70 arx)) 1)))
(progn
(princ "\nSORRY, ONLY CLOSED LWPOLYLINES ALLOWED...")
(setq ex 1)
)
)
(if (= ex 0)
(progn
(command "_undo" "m") ;if something goes bad, you may return here
(command "_layer" "m" "Area_Division" "")
(command "_area" "e" arxon)
(setq ar(getvar "area"))
(initget "Divide Cut")
(setq strdc(getkword "\nDIVIDE by number or CUT a part ? (D/C) :"))
(if (= strdc "Divide")
(progn
(setq k (getreal "\nEnter number to divide the whole part by : "))
(setq tem(/ ar k))
)
)
(if (= strdc "Cut")
(setq tem (getreal "\nEnter area to cut from the whole part (m2) : "))
)
(initget "Parallel Fixed")
(setq strpf(getkword "\nPARALLEL to a direction or FIXED side? (P/F) :"))
(if (= strpf "Fixed")
(fixpt)
)
(if (= strpf "Parallel")
(parpt)
)
(ready)
)
(ready)
)
)
;******************************************************************************
(defun fixpt ()
(setvar "osmode" osm)
(setq scl 0.05
p1 (getpoint "\nPick fixed point of the division line : ")
p2 (getpoint "\nPick second point of division line: ")
)
(setvar "osmode" 0)
(command "_line" p1 p2 "")
(setq deln (entlast))
(setq pts (getpoint "\nPick any point into FIRST piece, FAR from division line: "))
(setq ptb (getpoint "\nPick any point into the REST of the piece, FAR from division line: "))
(setvar "blipmode" 0)
(princ "\nPlease wait...")
(command "_boundary" pts "")
(command "_area" "e" "l")
(setq par(getvar "area"))
(setq ok -1)
(if (< par tem)
(progn
(while (< par tem)
(entdel (entlast))
(if (< (- tem par) 50)(setq scl stp))
(if (< (- tem par) 10)(setq scl stp2))
(command "_rotate" deln "" p1 (* scl ok))
(command "_boundary" pts "")
(command "_area" "e" "l")
(if (< (getvar "area") par)
(setq ok(* ok -1))
)
(setq par(getvar "area"))
);endwhile
(entdel deln)
)
(progn
(while (> par tem)
(entdel (entlast))
(if (< (- par tem) 50)(setq scl stp))
(if (< (- par tem) 10)(setq scl stp2))
(command "_rotate" deln "" p1 (* scl ok))
(command "_boundary" pts "")
(command "_area" "e" "l")
(if (> (getvar "area") par)
(setq ok(* ok -1))
)
(setq par(getvar "area"))
);endwhile
(entdel deln)
)
)
(command "_change" "l" "" "p" "c" "green" "")
(command "_boundary" ptb "")
(command "_change" "l" "" "p" "c" "red" "")
(ready)
)
;******************************************************************************
(defun parpt ()
(setvar "osmode" osm)
(setq scl 0.25
p1 (getpoint "\nPick one point of division line (far from lwpoly) : ")
p2 (getpoint "\nPick other point of division line (far from lwpoly) : ")
)
(setvar "osmode" 0)
(command "_line" p1 p2 "")
(setq deln(entlast))
(setq pts (getpoint "\nPick any point into FIRST piece, FAR from division line: "))
(setq ptb (getpoint "\nPick any point into the REST of the piece, FAR from division line: "))
(setvar "blipmode" 0)
(princ "\nPlease wait...")
(command "_boundary" pts "")
(command "_area" "e" "l")
(setq par(getvar "area"))
(if (< par tem)
(progn
(while (< par tem)
(entdel (entlast))
(if (< (- tem par) 50)(setq scl stp1))
(if (< (- tem par) 10)(setq scl stp2))
(command "_offset" scl deln ptb "")
(entdel deln)
(setq deln(entlast))
(command "_boundary" pts "")
(command "_area" "e" "l")
(setq par(getvar "area"))
)
(entdel deln)
)
(progn
(while (> par tem)
(entdel (entlast))
(if (< (- par tem) 50)(setq scl stp1))
(if (< (- par tem) 10)(setq scl stp2))
(command "_offset" scl deln pts "")
(entdel deln)
(setq deln(entlast))
(command "_boundary" pts "")
(command "_area" "e" "l")
(setq par(getvar "area"))
)
(entdel deln)
)
)
(command "_change" "l" "" "p" "c" "green" "")
(command "_boundary" ptb "")
(command "_change" "l" "" "p" "c" "red" "")
)
;******************************************************************************
(defun ready ()
(princ scl)
(princ "\nActual : ")
(princ par)
(princ "\nMust be: ")
(princ tem)
(setq *error* olderr)
(setvar "osmode" osm)
(setvar "cmdecho" 1)
(setvar "blipmode" 1)
(princ "\nThanks...")
(princ)
);close defun

0 Likes
Accepted solutions (1)
1,226 Views
2 Replies
Replies (2)
Message 2 of 3

ВeekeeCZ
Consultant
Consultant

Did you use the lisp successfully before? Do you know how it works?

 

1) read all the perex carefully and in detail.

2) post a dwg sample where it fails.

Message 3 of 3

Kent1Cooper
Consultant
Consultant
Accepted solution

By "does not select the object," do you mean that you get the "SORRY, ONLY CLOSED LWPOLYLINES ALLOWED..." message, even when you pick a closed Polyline?  If so, this is probably the problem:

 

(if (not (and (equal (cdr (assoc 0 arx)) "LWPOLYLINE") (= (cdr (assoc 70 arx)) 1)))

 

That last test will be satisfied for a closed Polyline only if linetype generation is disabled.  If it's enabled  for the Polyline, that value will be 129.  Try using a test not  for whether the (assoc 70) value is 1 specifically, but instead for whether the 1 bit [= closed] is present in  the (assoc 70) value, so that the test will be satisfied whether or not  linetype generation is enabled:

 

(if (not (and (equal (cdr (assoc 0 arx)) "LWPOLYLINE") (= (logand (cdr (assoc 70 arx)) 1) 1)))

 

 

Kent Cooper, AIA
0 Likes