;| ;;
DHLINE Dynamic Hidden Line ;;
By: Andrea Andreetti ;;
v.1.0 2009-01-25 ;;
v.1.1 2009-01-27 ;;
– FIX (vl-load-com) ;;
– FIX vl-sort intersection points ;;
v.1.2 2009-01-27 ;;
– FIX Detection of “HIDDEN” ;;
v.1.3 2009-01-27 ;;
– FIX Right click Cancel last entity ;;
|;
(princ “n
– Dynamic Hidden Line –
By.: Andrea Andreetti v.1.3″)
;| ;;
DHLINE Command ;;
|;
;;
(vl-load-com)
(defun c:de (/ lp1 linf)
(setq prompton t)
(vla-startundomark
(vla-get-activedocument (vlax-get-acad-object))
)
(setq lp1 (getpoint “nStart..”))
(if (eq (getvar “measurement”) 0)
(setq linf (findfile “acad.lin”))
(setq linf (findfile “acadiso.lin”))
)
(if linf
(if (not (member “HIDDEN”
(mapcar ‘strcase (ai_table “LTYPE” 4))
)
)
(vl-cmdf “._Linetype” “_L” “HIDDEN” linf “”)
)
)
(dhline)
(vla-endundomark
(vla-get-activedocument (vlax-get-acad-object))
)
(princ “nDone !”)
(princ)
)
;;
;| ;;
DHLINE Command ;;
|;
;| ;;
DHLINE function ;;
|;
;;
(defun dhline (/ cecolor ccol lp2 interlist ent1 ent2 cilen
ci# int iea ieb drline endpoint lp1f col
c62 drlines snapa orthm tx)
(setvar “CMDECHO” 0)
(setq snapa (getvar “snapang”))
(setq orthm (getvar “ORTHOMODE”))
(if prompton
(progn (princ “nPress SHIFT to switch Lines ! “)
(setq prompton nil)
)
)
(defun *error* (msg)
(if drline
(progn (vl-cmdf “._erase” drline “”)
(setq drline nil)
(princ)
)
)
(if drlines
(progn (foreach n drlines (vl-cmdf “._erase” n “”))
(setq drlines nil)
(princ)
)
)
(redraw)
(princ (strcat “n” msg))
)
(defun dtr (a) (* pi (/ a 180.0)))
(defun rtd (a) (/ (* a 180) pi))
(setq cecolor (strcase (getvar “cecolor”)))
(if (or (eq cecolor “BYLAYER”) (eq cecolor “BYBLOCK”))
(setq ccol (cdr
(assoc 62 (entget (tblobjname “layer” (getvar “CLAYER”))))
)
)
(setq ccol (read cecolor))
)
(while (or (and (setq input (grread t 4 4)) (= (car input) 5))
(and (= (car input) 2) (= (cadr input) 15))
)
(if (= (car input) 5)
(setq lp2 (cadr input))
)
(if (and (= (car input) 2) (= (cadr input) 15))
(setq operation “ORTHO”)
)
;;SWITCH ORTHOMODE ;;
;;
(if (eq operation “ORTHO”)
(progn (if (eq orthm 1)
(progn (setvar “ORTHOMODE” 0) (setq orthm 0))
(progn (setvar “ORTHOMODE” 1) (setq orthm 1))
)
(setq operation nil)
)
)
(if (eq orthm 1)
(dhlineorthomode)
)
;;
;;SWITCH ORTHOMODE ;;
;;FROM ACADISO.LIN
;;Make sur to load the Linetype or change as your need
(if (acet-sys-shift-down)
(setq lty “HIDDEN”)
(setq lty nil)
)
(if drline
(progn (vl-cmdf “._erase” drline “”)
(setq drline nil)
(princ)
)
)
(if drlines
(progn (foreach n drlines (vl-cmdf “._erase” n “”))
(setq drlines nil)
(princ)
)
)
(if txts
(progn (foreach n txts (vl-cmdf “._erase” n “”))
(setq txts nil)
(princ)
)
)
(createline lp1 lp2 nil)
(setq ci (ssget “_F” (list lp1 lp2)))
(if ci
(progn (setq interlist nil)
(setq ent1 (vlax-ename->vla-object drline))
(setq handid (vla-get-handle ent1))
(setq cilen (sslength ci))
(setq ci# -1)
(repeat (1- cilen)
(setq int nil)
(setq ent2 (vlax-ename->vla-object (ssname ci (setq ci# (1+ ci#)))))
(if (eq (vla-get-layer ent2) (getvar “CLAYER”))
(progn (setq iea (vlax-variant-value
(vla-intersectwith ent1 ent2 acextendnone)
)
)
(setq ieb (vlax-safearray-get-u-bound iea 1))
(if (/= ieb -1)
(progn (setq int (vlax-safearray->list iea))
(if (> ieb 3)
(repeat (/ (1+ ieb) 3)
(setq interlist (append interlist
(list (list (nth 0 int) (nth 1 int) (nth 2 int)))
)
)
(setq int (cdddr int))
)
(setq interlist (append interlist (list int)))
)
)
)
)
) ;_if
) ;_repeat
(redraw)
(if (not interlist)
(progn (setq endpoint lp2) (grdraw lp1 lp2 ccol 0))
(progn ;;VLSORT ;;
;;
(setq d_interlist nil)
(foreach n interlist
(setq dista (distance lp1 n))
(setq d_interlist (append d_interlist (list (cons (rtos dista) n))))
)
(setq dlist (vl-sort (mapcar ‘(lambda (x) (read (car x))) d_interlist)
‘<
)
)
(setq dlist (mapcar ‘(lambda (x) (rtos x)) dlist))
(setq interlist2 nil)
(foreach n dlist
(setq interlist2 (append interlist2 (list (cdr (assoc n d_interlist)))))
)
(setq interlist interlist2)
;;
;;VLSORT ;;
(setq lp1f lp1)
(setq col ccol)
(if drline
(progn (vl-cmdf “._erase” drline “”)
(setq drline nil)
(princ)
)
)
(if drlines
(progn (foreach n drlines (vl-cmdf “._erase” n “”))
(setq drlines nil)
(princ)
)
)
(if txts
(progn (foreach n txts (vl-cmdf “._erase” n “”))
(setq txts nil)
(princ)
)
)
(setq tx 0)
(foreach n interlist
(if (or (/= (car lp1) (car n)) (/= (cadr lp1) (cadr n)))
(progn (createlines lp1f n lty)
;;(CreateTexts n (itoa (setq tx (1+ tx))))
(if (not lty)
(setq lty “HIDDEN”)
(setq lty nil)
)
(setq col (1+ col))
(setq lp1f n)
(setq endpoint n)
)
)
)
(createlines lp1f lp2 lty)
)
)
)
)
) ;_while
(redraw)
(if (eq (car input) 11)
(progn (if drline
(progn (vl-cmdf “._erase” drline “”)
(setq drline nil)
(princ)
)
)
(if drlines
(progn (foreach n drlines (vl-cmdf “._erase” n “”))
(setq drlines nil)
(princ)
)
)
)
)
(if (eq (car input) 3)
(progn (setq lastiems nil) (setq lp1 lp2) (dhline))
)
(if lastiems
(progn (foreach n lastiems (vl-cmdf “._erase” n “”))
(setq lastiems nil)
(princ)
)
)
) ;_defun
;;
;| ;;
DHLINE function ;;
|;
;| ;;
DHLINE TEXT (for test) ;;
|;
;;
(defun CreateTexts (point tx)
(setq DHLSTRING (strcat “\pxsm1.5,ql;{\fArial|b0|i0|c0|p34;\L\O” tx “\P\ps*,q*;\l\o}”)
)
(setq ViewSize (getvar “VIEWSIZE”))
(setq DHLTdata
(entmakex
(list
(cons 0 “MTEXT”)
(cons 100 “AcDbEntity”)
(cons 100 “AcDbMText”)
(cons 1 DHLSTRING)
(cons 10
(polar point 0 (/ ViewSize 90.0))
)
(cons 40 (/ ViewSize 70.0))
(cons 50 0.0)
(cons 62 250)
(cons 71 1)
(cons 72 5)
(cons 90 1)
(cons 63 9)
(cons 45 1.2)
)
)
)
(setq txts (append txts (list DHLTdata)))
)
;;
;| ;;
DHLINE TEXT (for test) ;;
|;
;| ;;
ORTHO function ;;
|;
;;
(defun DHlineOrthoMode (/ distP NorthP WestP EastP SouthP)
(setq distP (distance lp1 lp2))
(setq NorthP (polar lp1 (+ snapA (dtr 90)) distP))
(setq WestP (polar lp1 (+ snapA (dtr 180)) distP))
(setq EastP (polar lp1 snapA distP))
(setq SouthP (polar lp1 (- snapA (dtr 90)) distP))
(if (and
(< (distance lp2 NorthP) (distance lp2 WestP))
(< (distance lp2 NorthP) (distance lp2 EastP))
(< (distance lp2 NorthP) (distance lp2 SouthP))
)
(setq lp2 NorthP)
)
(if (and
(< (distance lp2 WestP) (distance lp2 NorthP))
(< (distance lp2 WestP) (distance lp2 EastP))
(< (distance lp2 WestP) (distance lp2 SouthP))
)
(setq lp2 WestP)
)
(if (and
(< (distance lp2 EastP) (distance lp2 WestP))
(< (distance lp2 EastP) (distance lp2 NorthP))
(< (distance lp2 EastP) (distance lp2 SouthP))
)
(setq lp2 EastP)
)
(if (and
(< (distance lp2 SouthP) (distance lp2 WestP))
(< (distance lp2 SouthP) (distance lp2 EastP))
(< (distance lp2 SouthP) (distance lp2 NorthP))
)
(setq lp2 SouthP)
)
)
;;
;| ;;
ORTHO function ;;
|;
;| ;;
LineS creation ;;
|;
;;
(defun CreateLines (c1 c2 c3)
(setq c62 ccol)
(if (eq cecolor “BYLAYER”)
(setq c62 nil)
)
(if (eq cecolor “BYBLOCK”)
(setq c62 0)
)
(setq LineData (list
‘(0 . “LINE”)
(cons 10 c1)
(cons 11 c2)
)
)
(if lty (setq c62 1))
;;Color
(if c62
(setq LineData (append LineData (list (cons 62 c62))))
)
;Linetype
(if c3
(setq LineData (append LineData (list (cons 6 c3))))
)
(setq DrL
(entmakex LineData
)
)
(setq DrLines (append DrLines (list DrL)))
(setq Lastiems DrLines)
)
;;
;| ;;
LineS creation ;;
|;
;| ;;
FirstLine creation ;;
|;
;;
(defun CreateLine (c1 c2 c3)
(if DrLine
(progn
(vl-cmdf “._erase” DrLine “”)
(setq DrLine nil)
(princ)
)
)
(setq c62 ccol)
(if (eq cecolor “BYLAYER”)
(setq c62 nil)
)
(if (eq cecolor “BYBLOCK”)
(setq c62 0)
)
(setq LineData (list
‘(0 . “LINE”)
(cons 10 c1)
(cons 11 c2)
)
)
;;Color
(if c62
(setq LineData (append LineData (list (cons 62 c62))))
)
;Linetype
(if c3
(setq LineData (append LineData (list (cons 6 c3))))
)
(setq DrLine
(entmakex LineData
)
)
(setq Lastiems (list DrLine))
)
;;
;| ;;
FirstLine creation ;;
|;
;|첲isual LISP?Format Options?
(120 2 1 2 nil “Ende von ” 60 20 1 1 0 nil nil nil T)
;*** DO NOT add text below the comment! ***|;