One more item I can't solve for the life of me.....
The routine works great, but when it creates the new polyline, it always creates it on the current layer. I would like the new polyline to be created on the same layer as the first entity that was selected. In this instance, the new polyline should be created on the cyan layer "Proposed Contours."
I've been combing the forums and believe I have the correct way to identify the layer of the first selected entity. The last step in the routine should be to change the layer of the newly created polyline from the current layer to the identified layer. What am I messing up?
; fillet with Radius, First keep, second trim
(defun c:FCLL (/ *error* adoc oVAR nVAR getval e1 e2 entq p2 l l1 e er ss 1pt 2pt midpt ename param oblouk LayerName z1)
;********
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
(princ (strcat "\nError: " errmsg)))
(mapcar 'setvar nVAR oVAR)
(vla-endundomark adoc)
(princ))
;;; GETVAL - returns the group value of an entity.
;;; like the wellknown (dxf) function but accepts all kinds of
;;; entity representations (ename, entget list, entsel list)
(defun GETVAL (grp ele) ;"dxf value" of any ent...
(cond ((= (type ele) 'ENAME) ;ENAME
(cdr (assoc grp (entget ele)))
)
((not ele) nil) ;empty value
((not (listp ele)) nil) ;invalid ele
((= (type (car ele)) 'ENAME) ;entsel-list
(cdr (assoc grp (entget (car ele))))
)
(T (cdr (assoc grp ele))))
); end getval
(vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
(setq oVAR (mapcar 'getvar (setq nVAR '(CMDECHO TRIMMODE PEDITACCEPT OSMODE))))
(mapcar 'setvar nVAR '(0 0 1 0 ))
(setvar "filletrad" (cond ((getreal (strcat "\nSpecify fillet radius <" (rtos (getvar "filletrad") 2 2) ">: ")))
(T (getvar "filletrad"))))
(while (and (null (setq e1 (entsel "\nSelect first object (TO BE MODIFIED): ")))
(wcmatch (getval 0 e1) "LINE,ARC,LWPOLYLINE")))
;Identify the layer of the first selected entity
(setq z1 (entget (car e1)))
(setq LayerName (assoc 8 z1))
(redraw (car e1) 3)
(while (and (null (setq e2 (entsel "\nSelect second object (REMAINS THE SAME): ")))
(wcmatch (getval 0 e2) "LINE,ARC,LWPOLYLINE")))
(redraw (car e2) 3)
(setq p1 (cadr e1))
(setq e1 (car e1))
(if (= (getval 0 e1) "LWPOLYLINE") ;if 1nd polyline
(progn
(setq l (entlast))
(command "_.EXPLODE" e1) ;make it line or arc (would be trimed)
(setq ss (ssadd))
(ssadd (setq e (entnext l)) ss)
(while (setq e (entnext e))
(ssadd e ss))))
(if (= (getval 0 e2) "LWPOLYLINE") ;if 2st polyline
(progn
(setq ename (car e2)
midpt (vlax-curve-getClosestPointTo ename (trans (cadr e2) 1 0))
param (vlax-curve-getParamAtPoint ename midpt)
1pt (vlax-curve-getPointAtParam ename (fix param))
2pt (vlax-curve-getPointAtParam ename (1+ (fix param))))
(if (> (abs (- (- (vlax-curve-getDistAtPoint ename 2pt)
(vlax-curve-getDistAtPoint ename 1pt))
(distance 2pt 1pt)))
0.002)
(setq oblouk T))
(if oblouk
(command "_.ARC" 1pt midpt 2pt) ;make it line or arc (would be keeped)
(command "_.LINE" 1pt 2pt ""))
(setq l2 (cons (entlast) (list (cadr e2)))))) ;if 1st line or arc
(if (wcmatch (getval 0 e2) "LINE,ARC,CIRCLE")
(progn
(entmake (entget (car e2))) ;duplicat it
(setq l2 (cons (entlast) (list (cadr e2))))))
(setvar "trimmode" 1)
(command "_.FILLET" (nentselp p1) l2) ;new arc
(setq er (entlast))
(entdel (car l2)) ;trim substitude of 1st erased
(if ss (command "_.PEDIT" er "_J" ss "" "")) ;if 2nd was pl, recreate pl
(if ss (command "_.ERASE" ss "")) ;the rest of it (2nd side) erase
;Need to switch the layer of the polyline from current layer to the identified layer
;Found code below on forums but can't get it to work
(command "_.CHANGE" sel "" "_properties" "_LAYER" LayerName "")
(command "_.REGEN")
(*error* "end")
(princ)
)
