Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 10/31/2018 in all areas

  1. Late to the party, and I don't do ducting, but Lee Mac has a great lisp, which might interest you. http://www.lee-mac.com/mpline.html Thanks Lee! When in doubt, check Lee Mac out.
    1 point
  2. I have noticed many requests on multiple sites, forums, and threads for updates to some rendition/version or modification of this lisp. It is truly hard to imagine how many users must be using it. On the other hand, it appears the users now making requests for modifications have little knowledge of or appreciation for the developer(s). Out of respect for ASMI, the originator, the one who developed the groundwork of the code, for which I developed atop of. I chose to post my latest revision/version of the code under the original thread. Maybe, just maybe it will be a good read for those who might appreciate the development history. Or not, and just come for the updated code. So, who is having problems with their duct code using multiline objects? Sorry, this code creates polylines just like the previous versions which incorporated and allow for hatching the objects. So, who wanted a text label? Text label has been incorporated to include the input width along with a user-defined suffix. Text created only at straight segments. Ducters, For a depth of 12 units, use suffix x12 or /12 Pipers, For diameter symbol suffix = %%C For " inch symbol suffix = \" For inch and diameter suffix = \"%%C Oh! and who wanted a chamfered style elbow/corner for cable tray? As shown in earlier post under this thread. Enjoy. WPIPE[12].LSP
    1 point
  3. One more modification for one step Undo, [Length/Undo] in command line and restoring default polyline width: (defun c:duct(/ oldWd oldFil oldEch lEnt pl1 actDoc pl2 vLst1 vLst2 stLst *error* oldWid) (vl-load-com) (defun GetPlineVer(plObj) (mapcar 'cdr (vl-remove-if-not '(lambda(x)(=(car x)10)) (entget plObj))) ); end of GetPLineVer (defun asmi-LayersUnlock(/ restLst) (setq restLst '()) (vlax-for lay (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (setq restLst (append restLst (list (list lay (vla-get-Lock lay) (vla-get-Freeze lay) ); end list ); end list ); end append ); end setq (vla-put-Lock lay :vlax-false) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Freeze(list lay :vlax-false))) t) ); end vlax-for restLst ); end of asmi-LayersUnlock (defun asmi-LayersStateRestore(StateList) (foreach lay StateList (vla-put-Lock(car lay)(cadr lay)) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-Freeze(list(car lay)(nth 2 lay)))) t) ); end foreach (princ) ); end of asmi-LayersStateRestore (defun *error*(msg) (if(and oldEch oldFil) (progn (setvar "CMDECHO" oldEch) (setvar "FILLMODE" oldFil) (setvar "PLINEWID" oldWid) ); end progn ); end if (if actDoc (vla-EndUndoMark actDoc) ); end if (princ) ); end of *error* (if(not duct:pWd)(setq duct:pWd 1.0)) (setq oldWd duct:pWd duct:pWd(getdist (strcat "\nSpecify pipe diameter <" (rtos duct:pWd) ">: ")) oldFil(getvar "FILLMODE") oldEch(getvar "CMDECHO") oldWid(getvar "PLINEWID") ); end setq (if(null duct:pWd)(setq duct:pWd oldWd)) (mapcar 'setvar '("CMDECHO" "FILLMODE") '(0 0)) (if(entlast)(setq lEnt(entlast))) (vla-StartUndoMark (setq actDoc (vla-get-ActiveDocument (vlax-get-acad-object)))) (princ "\nSpecify start point: ") (command "_.pline" pause) (command "_w" duct:pWd duct:pWd) (while(= 1(getvar "CMDACTIVE")) (command pause) (princ "\nSpecify next point or [Length/Undo]: ") ); end while (if (not (equal lEnt(entlast))) (progn (setq lEnt(entlast) stLst(asmi-LayersUnlock)) (command "_.fillet" "_r" duct:pWd) (command "_.fillet" "_p" lEnt) (setq lEnt (vlax-ename->vla-object lEnt) pl1(car(vlax-safearray->list (vlax-variant-value (vla-Offset lEnt (/ duct:pWd 2))))) pl2(car(vlax-safearray->list (vlax-variant-value (vla-Offset lEnt (-(/ duct:pWd 2)))))) vLst1(GetPlineVer (vlax-vla-object->ename pl1)) vLst2(GetPlineVer (vlax-vla-object->ename pl2)) ); end setq (vla-put-ConstantWidth pl1 0.0) (vla-put-ConstantWidth pl2 0.0) (vla-Delete lEnt) (asmi-LayersStateRestore stLst) (foreach itm vLst1 (command "._line" itm (car vLst2) "") (setq vLst2(cdr vLst2)) ); end foreach ); end progn ); end if (vla-EndUndoMark actDoc) (setvar "CMDECHO" oldEch) (setvar "FILLMODE" oldFil) (setvar "PLINEWID" oldWid) (princ) ); end of c:duct
    1 point
×
×
  • Create New...