CAD 2011+ and xdapi
 - (defun c:tt (/ oldlyr)
- (if (tblsearch "layer" "$tmpcheck")
- (setq oldlyr (getvar "clayer"))
- (progn
- (setq oldlyr (getvar "clayer"))
- (vl-cmdf ".layer" "m" "$tmpcheck" "c" "1" "" "")
- )
- )
- (xdrx_undostart)
- (vl-catch-all-apply
- (function
- (lambda (/ ss el e1 el1 e2 pts pams z1 z2 tf pams1 s)
- (if (setq ss (ssget '((0 . "*polyline") (8 . "JMD"))))
- (progn
- (setvar "clayer" "$tmpcheck")
- (setvar "pdmode" 35)
- (setvar "pdsize" 1)
- (setq el (xdrx_pickset->ents ss))
- (xdrx_setmark)
- (while el
- (setq e1 (car el)
- el1 (cdr el)
- z1 (getpropertyvalue e1 "Elevation")
- )
- (while el1
- (setq e2 (car el1)
- z2 (getpropertyvalue e2 "Elevation")
- )
- (if (/= z2 z1)
- (progn
- (setpropertyvalue e2 "Elevation" z1)
- (setq tf t)
- )
- )
- (if (setq pts (xdrx_curve_getinters e1 e2 0))
- (progn
- (setq
- pams (vl-remove
- nil
- (mapcar
- '(lambda (x)
- (vlax-curve-getparamatpoint e1 x)
- )
- pts
- )
- )
- pams1 (mapcar
- '(lambda (x)
- (vlax-curve-getparamatpoint e2 x)
- )
- pts
- )
- )
- (if (and pams pams1)
- (mapcar
- '(lambda (x y z)
- (if
- (not (or
- (and (= (fix x) x) (/= (fix z) z))
- (and (/= (fix x) x) (= (fix z) z))
- (and (= (fix x) x) (= (fix z) z))
- )
- )
- (xdrx_point_make y)
- )
- )
- pams
- pts
- pams1
- )
- )
- )
- )
- (if tf
- (setpropertyvalue e2 "Elevation" z2)
- )
- (setq el1 (cdr el1)
- tf nil
- )
- )
- (setq el (cdr el))
- )
- (if (setq s (xdrx_getss))
- (sssetfirst nil s)
- )
- )
- )
- )
- )
- )
- (xdrx_undoend)
- (setvar "clayer" oldlyr)
- (princ)
- )
|