Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 09/18/2020 in all areas

  1. like this? (defun c:t1 ( ) (mapcar 'ditch-dash '("c:/Transmittals/drawing1-layout.pdf" "c:/Transmittals/drawing2-layout.pdf" "c:/Transmittals/drawing3-layout.pdf"))) (defun ditch-dash (s / i) (if (setq i (vl-string-position (ascii "-") s nil T))(strcat (substr s 1 i )(last (fnsplitl s))) s)) (setq test (c:t1))
    1 point
  2. Re all your lisp you can make a custom menu very easy that will have all your lisps ready to use. 1st step is to save all your lisps in a common directory then they wont clutter your desktop. You just need to add a support and trusted path for the location of the lisps. You just use notepad save as say SHADI.MNU and use menuload to load it. ***MENUGROUP=SHADI ***POP20 **SHADILIB [LIBRARY] [1/4 POINTS]^C^C(LOAD "1-4 POINTS") [Add 2 Level]^C^C(LOAD "add-to-levels") [Add-pits-drain]^C^C(LOAD"Add-pits-drain") [Allbylayer]^C^C(LOAD "Allbylayer") [Channel Flow]^c^c^p(load "channel flow") [Chevron lines]^c^c^p(load "chevron") chevron [Color2layer]^C^C^p(LOAD "color2layer")
    1 point
  3. > The Courage Dog & jason tay There is new version with some improvements. 'Letters' version for Courage Dog: (defun c:tabord(/ aCen cAng cCen cPl cRad cReg fDr it lCnt lLst mSp pCen pT1 pT2 ptLst R tHt tLst vlaPl vlaTab vLst cTxt oldCol nPl clFlg actDoc tPt1 tPt2 cAng tiPt oSnp *error*) (vl-load-com) (defun Extract_DXF_Values(Ent Code) (mapcar 'cdr (vl-remove-if-not '(lambda(a)(=(car a)Code)) (entget Ent))) ); end of (defun *error*(msg) (setvar "CMDECHO" 1) (if oSnp(setvar "OSMODE" oSnp)) (if mSp(vla-EndUndoMark actDoc)) (princ) ); end of *error* (defun Alph_Num(Counter / lLst cRes) (setq lLst '("A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z")) (if(<= 1.0(setq cRes(/ Counter 26.0))) (strcat(itoa(fix cRes)) (nth(- Counter(* 26(fix cRes)))lLst)) (nth Counter lLst) ); end if ); end of Alph_Num (if (and (setq cPl(entsel "\nSelect LwPoliline > ")) (= "LWPOLYLINE"(car(Extract_DXF_Values(car cPl)0))) ); end and (progn (princ "\nPlease Wait... \n") (setq vlaPl(vlax-ename->vla-object(car cPl)) ptLst(mapcar 'append (setq vLst(Extract_DXF_Values(car cPl)10)) (mapcar 'list(Extract_DXF_Values(car cPl)42))) r 2 lCnt 0 tLst '((1 0 "Point")(1 1 "X")(1 2 "Y")(1 3 "Radius")) actDoc(vla-get-ActiveDocument (vlax-get-acad-object)) mSp(vla-get-ModelSpace actDoc) tHt(getvar "TEXTSIZE") ); end setq (setvar "CMDECHO" 0) (setq oSnp(getvar "OSMODE")) (vla-StartUndoMark actDoc) (foreach vert ptLst (setq vert(trans vert 0 1) tLst(append tLst (list(list r 0(Alph_Num lCnt)) (list r 1(rtos(car vert)2 4)) (list r 2(rtos(cadr vert)2 4)) (list r 3 "")))) (if(and (/= 0.0(last vert)) (setq pt1(vlax-curve-GetPointAtParam vlaPl lCnt)) (setq pt2(vlax-curve-GetPointAtParam vlaPl(1+ lCnt))) ); end and (setq r(1+ r) cRad(abs(/(distance pt1 pt2) 2(sin(/(* 4(atan(abs(last vert))))2)))) aCen(vlax-curve-GetPointAtParam vlaPl(+ 0.5 lCnt)) fDr(vlax-curve-getFirstDeriv vlaPl (vlax-curve-getParamAtPoint vlaPl aCen)) pCen(trans (polar aCen(-(if(minusp(last vert)) pi(* 2 pi)) (atan(/(car fDr)(cadr fDr))))cRad)0 1) tLst(append tLst(list (list r 0 "center") (list r 1(rtos(car pCen)2 4)) (list r 2(rtos(cadr pCen)2 4)) (list r 3(rtos cRad 2 4)))) ); end setq ); end if (setq r(1+ r) lCnt(1+ lCnt)) ); end foreach (setq vlaTab(vla-AddTable mSp (vlax-3D-point '(0 0 0)) (+ 1(/(length tLst)4)) 4 (* 3 tHt)(* 20 tHt))) (foreach i tLst (vl-catch-all-apply 'vla-SetText(cons vlaTab i)) (vla-SetCellTextHeight vlaTab(car i)(cadr i)tHt) (vla-SetCellAlignment vlaTab(car i)(cadr i)acMiddleCenter) ); end foreach (vla-put-VertCellMargin vlaTab (* 0.75 tHt)) (vla-put-Height vlaTab(* 1.75(/(length tLst)4))) (vla-SetColumnWidth vlaTab 0 (* 10 tHt)) (vla-SetColumnWidth vlaTab 3 (* 12 tHt)) (vla-put-RepeatTopLabels vlaTab :vlax-true) (vla-put-BreakSpacing vlaTab (* 3 tHt)) (vla-DeleteRows vlaTab 0 1) (princ "\n<<< Place Table >>> ") (command "_.copybase" (trans '(0 0 0)0 1)(entlast) "") (command "_.erase" (entlast) "") (command "_.pasteclip" pause) (if(= :vlax-true(vla-get-Closed vlaPl)) (progn (setq nPl(vla-Copy vlaPl)) (command "_.region" (entlast) "") (setq cCen(vlax-get(setq cReg (vlax-ename->vla-object(entlast)))'Centroid)) (vla-Delete cReg) (setq clFlg T) ); end progn ); end if (setq lCnt 0) (foreach v vLst (if clFlg (setq cAng(angle cCen(trans v 0 1)) iPt(polar v cAng (* 2 tHt))) (setq tPt1(vlax-curve-GetPointAtParam vlaPl (- lCnt 0.0000001)) tPt2(vlax-curve-GetPointAtParam vlaPl (+ lCnt 0.0000001)) iPt(polar v(+(* pi 0.5)(if(minusp (setq cAng(angle tPt1(if tPt2 tPt2 (polar tPt1(* 0.5 pi)0.0000001))))) cAng(- cAng)))(* 2 tHt)) ); end setq ); end if (setvar "OSMODE" 0) (setq cTxt(vla-AddText mSp(Alph_Num lCnt) (vlax-3d-point iPt) tHt) tiPt(vla-get-InsertionPoint cTxt) lCnt(1+ lCnt) ); end setq (vla-put-Alignment cTxt 10) (vla-put-TextAlignmentPoint cTxt tiPt) (setq oldCol(getvar "CECOLOR")) (setvar "CECOLOR" "1") (command "_.circle" v (/ tHt 3)) (setvar "CECOLOR" oldCol) ); end foreach (setvar "OSMODE" oSnp) (setvar "CMDECHO" 1) (vla-EndUndoMark actDoc) ); end progn (princ "\n<!> It isn't LwPolyline! Quit. <!> ") ); end if (gc) (princ) ); end of c:tabord 'Number' version for jason tay: (defun c:tabord2(/ aCen cAng cCen cPl cRad cReg fDr it lCnt lLst mSp pCen pT1 pT2 ptLst R tHt tLst vlaPl vlaTab vLst cTxt oldCol nPl clFlg actDoc tPt1 tPt2 cAng tiPt oSnp *error*) (vl-load-com) (defun Extract_DXF_Values(Ent Code) (mapcar 'cdr (vl-remove-if-not '(lambda(a)(=(car a)Code)) (entget Ent))) ); end of (defun *error*(msg) (setvar "CMDECHO" 1) (if oSnp(setvar "OSMODE" oSnp)) (if mSp(vla-EndUndoMark actDoc)) (princ) ); end of *error* (if (and (setq cPl(entsel "\nSelect LwPoliline > ")) (= "LWPOLYLINE"(car(Extract_DXF_Values(car cPl)0))) ); end and (progn (princ "\nPlease Wait... \n") (setq vlaPl(vlax-ename->vla-object(car cPl)) ptLst(mapcar 'append (setq vLst(Extract_DXF_Values(car cPl)10)) (mapcar 'list(Extract_DXF_Values(car cPl)42))) r 2 lCnt 0 tLst '((1 0 "Point")(1 1 "X")(1 2 "Y")(1 3 "Radius")) actDoc(vla-get-ActiveDocument (vlax-get-acad-object)) mSp(vla-get-ModelSpace actDoc) tHt(getvar "TEXTSIZE") ); end setq (vla-StartUndoMark actDoc) (setvar "CMDECHO" 0) (setq oSnp(getvar "OSMODE")) (foreach vert ptLst (setq vert(trans vert 0 1) tLst(append tLst (list(list r 0(itoa(1+ lCnt))) (list r 1(rtos(car vert)2 4)) (list r 2(rtos(cadr vert)2 4)) (list r 3 "")))) (if(and (/= 0.0(last vert)) (setq pt1(vlax-curve-GetPointAtParam vlaPl lCnt)) (setq pt2(vlax-curve-GetPointAtParam vlaPl(1+ lCnt))) ); end and (setq r(1+ r) cRad(abs(/(distance pt1 pt2) 2(sin(/(* 4(atan(abs(last vert))))2)))) aCen(vlax-curve-GetPointAtParam vlaPl(+ 0.5 lCnt)) fDr(vlax-curve-getFirstDeriv vlaPl (vlax-curve-getParamAtPoint vlaPl aCen)) pCen(trans (polar aCen(-(if(minusp(last vert)) pi(* 2 pi)) (atan(/(car fDr)(cadr fDr))))cRad)0 1) tLst(append tLst(list (list r 0 "center") (list r 1(rtos(car pCen)2 4)) (list r 2(rtos(cadr pCen)2 4)) (list r 3(rtos cRad 2 4)))) ); end setq ); end if (setq r(1+ r) lCnt(1+ lCnt)) ); end foreach (setq vlaTab(vla-AddTable mSp (vlax-3D-point '(0 0 0)) (+ 1(/(length tLst)4)) 4 (* 3 tHt)(* 20 tHt))) (foreach i tLst (vl-catch-all-apply 'vla-SetText(cons vlaTab i)) (vla-SetCellTextHeight vlaTab(car i)(cadr i)tHt) (vla-SetCellAlignment vlaTab(car i)(cadr i)acMiddleCenter) ); end foreach (vla-put-VertCellMargin vlaTab (* 0.75 tHt)) (vla-put-Height vlaTab(* 1.75(/(length tLst)4))) (vla-SetColumnWidth vlaTab 0 (* 10 tHt)) (vla-SetColumnWidth vlaTab 3 (* 12 tHt)) (vla-put-RepeatTopLabels vlaTab :vlax-true) (vla-put-BreakSpacing vlaTab (* 3 tHt)) (vla-DeleteRows vlaTab 0 1) (princ "\n<<< Place Table >>> ") (command "_.copybase" (trans '(0 0 0)0 1)(entlast) "") (command "_.erase" (entlast) "") (command "_.pasteclip" pause) (if(= :vlax-true(vla-get-Closed vlaPl)) (progn (setq nPl(vla-Copy vlaPl)) (command "_.region" (entlast) "") (setq cCen(vlax-get(setq cReg (vlax-ename->vla-object(entlast)))'Centroid)) (vla-Delete cReg) (setq clFlg T) ); end progn ); end if (setq lCnt 0) (foreach v vLst (if clFlg (setq cAng(angle cCen(trans v 0 1)) iPt(polar v cAng (* 2 tHt))) (setq tPt1(vlax-curve-GetPointAtParam vlaPl (- lCnt 0.0000001)) tPt2(vlax-curve-GetPointAtParam vlaPl (+ lCnt 0.0000001)) iPt(polar v(+(* pi 0.5)(if(minusp (setq cAng(angle tPt1(if tPt2 tPt2 (polar tPt1(* 0.5 pi)0.0000001))))) cAng(- cAng)))(* 2 tHt)) ); end setq ); end if (setvar "OSMODE" 0) (setq cTxt(vla-AddText mSp(itoa(1+ lCnt)) (vlax-3d-point iPt) tHt) tiPt(vla-get-InsertionPoint cTxt) lCnt(1+ lCnt) ); end setq (vla-put-Alignment cTxt 10) (vla-put-TextAlignmentPoint cTxt tiPt) (setq oldCol(getvar "CECOLOR")) (setvar "CECOLOR" "1") (command "_.circle" v (/ tHt 3)) (setvar "CECOLOR" oldCol) ); end foreach (setvar "OSMODE" oSnp) (setvar "CMDECHO" 1) (vla-EndUndoMark actDoc) ); end progn (princ "\n<!> It isn't LwPolyline! Quit. <!> ") ); end if (gc) (princ) ); end of c:tabord2
    1 point
×
×
  • Create New...