Hi everyone, if someone could clean this lisp up to work in 2015 id really appreciate it. The lisp starts fine but I get an error when i select the text in 2015.
;; Adjust contour (polyline) elevations based on text label
;; Carl Bassler December 2002
(princ "Adjust contours to labeled elevations")
(princ "\tType CONEL to start")
(defun c:Conel ()
(setq OrigError *error* *error* ContourError)
(setvar "CMDECHO" 0)
(command "._UNDO" "_BE")
(initget "Select Global")
(setq Adj_Meth (getkword "Elevation adjust method [Select/Global] <Select>: "))
;;(if (not Adj_Meth) (setq Adj_Meth
"Select"))
(if (= Adj_Meth "Global")
(Adjust_Global)
(Adjust_Select)
);if
(command "._UNDO" "_END")
(setq *error* OrigError)
(princ)
);defun
;; ------ END MAIN DEFUN -----------
;;----------------------------------
(defun Adjust_Select ()
;;(setq PickFlag T)
(while (setq
TextPick (car (entsel "\nPick elevation text: ")))
(redraw TextPick 3)
(if (/= "TEXT" (Dxf 0 TextPick)) (progn (princ "\n**NOT TEXT**")
(exit)));;exit if not text
(setq ContElev (atof (Dxf 1 TextPick)))
(if (not (numberp (read (Dxf 1 TextPick)))) (progn (princ "\n**NOT A
NUMBER**") (exit)))
(while (setq ContPick (car (entsel (strcat "\nPick contour, set elev.= " (rtos ContElev 2 0) ": "))))
(setq EntType
(Dxf 0 ContPick))
(cond
((member EntType '("POLYLINE" "LWPOLYLINE"))
(command "._CHANGE" ContPick "" "_P" "_E" ContElev
"_C" "4" "")
)
(T (princ "\n**NOT A POLYLINE**"))
);cond
);while for contours
(redraw TextPick 4)
);while
for text select
);defun
;;---------------------------------
(defun Adjust_Global ()
(setq ChangeNo 0)
(princ "\nGroup select to include all contour
labels.......")
;;(setq SetAll (ssget '((0 . "TEXT,POLYLINE,LWPOLYLINE"))))
(setq SetTxt (ssget '((0 . "TEXT"))))
;;(command "._SELECT" SetAll
"")
;;(setq SetPline (ssget "P" '((0 . "POLYLINE,LWPOLYLINE"))))
(setq TextNum 0)
(setq NumTxt (sslength SetTxt))
(princ "Processing")
(repeat NumTxt
(setq TxtName (ssname SetTxt TextNum))
(setq ContElev (atof (Dxf 1 TxtName)))
(setq PlSet nil);clear variable
(if
(numberp (read (Dxf 1 TxtName)));if label is a number
(setq SelPts (GetFencePts TxtName);;pt list for pl selection
PlSet (ssget
"_F" SelPts '((0 . "POLYLINE,LWPOLYLINE")))
)
);if
(if PlSet ;skips if not NUMBER or no PL's selected
(progn
(setq
NumPl (sslength PlSet) PlNum 0)
(repeat NumPl
(setq PlName (ssname PlSet PlNum))
(command "._CHANGE" PlName ""
"_P" "_E" ContElev "_C" "4" "")
(setq ChangeNo (1+ ChangeNo));;counts PL's changed
(setq PlNum (1+ PlNum))
(princ ".")
);repeat
);progn
);if
(setq TextNum (1+ TextNum))
);repeat
(princ (strcat "\nChanged elevations of **"
(itoa ChangeNo) "** polylines"))
);defun
;;----------------------------------
(defun GetFencePts (Ename)
(setq TxtHt (dxf 40 Ename)
TxtStart
(dxf 10 Ename)
TxtWidth (caadr (textbox (entget Ename)))
TxtAngle (dxf 50 Ename)
;;fence pts extend above 1/3 ht and beyond 1.5
ht;;;
Pt1 (polar TxtStart (+ TxtAngle pi 0.2187) (* TxtHt 1.5366))
Pt2 (polar Pt1 (+ TxtAngle (/ pi 2)) (* TxtHt 1.6667))
Pt3
(polar Pt1 TxtAngle (+ TxtWidth (* TxtHt 3.0)))
Pt4 (polar Pt2 TxtAngle (+ TxtWidth (* TxtHt 3.0)))
);setq
(list Pt1 Pt2 Pt3 Pt4)
);defun
;;----------------------------------
(defun ContourError (msg)
(if (= msg "Function cancelled")
nil
(princ (strcat "\n**ConEl error** "
msg))
);if
(command "._UNDO" "_END")
(setq *error* OrigError)
);
;;---------------------------------
(defun Dxf (code ename)
(cdr (assoc code
(entget ename)))
);
;;----------------------------------
(princ)
Thanks
Alex
