Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 01/12/2023 in all areas

  1. You could try this: I made a bunch of global variables. They get set to the default. COMMAND sadv runs a function that asks you to set the values. You can run this once if you want. Those values are remembered as long as the file is open. ;;------------------------------------ DIMLP.LSP - label lines (Pipes) with detailed layer name---------------------------------;; ;; fixo () 2012 * all rights released ;; edited 3/3/12 ;; label lines (Pipes) with layer name ;;;;;;;;;;;;;;;;;;;;; ;; global variables, defaults (setq globalvar_YN "Pipe") (setq globalvar_Bg "No") (setq globalvar_ht (atof "1")) (setq globalvar_RP "Yes") (setq globalvar_txh1 2) (setq globalvar_MinLen 5) (setq a (substr " " 1 1)) (setq globalvar_pipetype "PVC PIPE") (setq globalvar_pipetype (strcat globalvar_pipetype a)) ;; setq a bunch of global variables, as variables. (defun setDefaults ( / YN Bg ht RP txh1 MinLen pipetype) (initget "Current Pipe") (if (null (setq YN (getkword "\nChoose Text Layer [Current/Pipe] <Pipe>: "))) (setq YN "Pipe") ) (initget "Yes No") (if (null (setq Bg (getkword "\nAdd Text Background [Yes/No] <No>: "))) (setq Bg "No") ) (setq ht (getreal "\nSet Length factor (If Drawing Units mm-Set 1000, If Drawig Units m-Set 1)<1>: ")) (if (= ht nil) (setq ht (atof "1")) ) (initget "Yes No") (if (null (setq RP (getkword "\nRound Pipe Length? [Yes/No] <Yes>: "))) (setq RP "Yes") ) ; (setq dcpr (getint "\nSet Decimal Precision <0>: ")) ; (if (= dcpr nil) ; (setq dcpr (atoi "0")) ; ) (setq ht (/ 1 ht)) (setq txh1 (getreal "\nEnter text height<2>: ")) (if (= txh1 nil) (setq txh1 2) ) (setq pipetype (getstring T "\nPipe Type<PVC PIPE>: ")) (if (= pipetype "") (setq pipetype "PVC PIPE") ) (setq MinLen (getreal "\nSet Min. Length To Calc<5.0>: ")) (if (= MinLen nil) (setq MinLen 5) ) (setq a (substr " " 1 1)) (setq pipetype (strcat pipetype a)) ; (setq pipepn (strcase (getstring "\nPipe Type</6>: "))) ; (if (= pipepn "") ; (setq pipepn "/6") ; ) ;; copy these default values to global vars (setq globalvar_YN YN) (setq globalvar_Bg Bg) (setq globalvar_ht ht) (setq globalvar_RP RP) (setq globalvar_txh1 txh1) (setq globalvar_MinLen MinLen) (setq globalvar_pipetype pipetype) ) (defun c:sadv ( / ) (setDefaults) (princ) ) (defun C:DIMLPDET_UPDATE(/ *error* acsp adoc ang curve deriv en mid mp ppt1 ppt2 prex sset txh txt txt1 txt2 txtln txtpt1 insut LAYERNAME offst pipetype pipepn a theMText dcpr RP MinLen) (vl-load-com) (setq mspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) (defun *error* (msg) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)) ) (cond ((or (not msg) (member msg '("console break" "Function cancelled" "quit / exit abort")) ) ) ((princ (strcat "\nError: " msg))) ) (princ) ) ;; copy the global vars values to local vars defaults (setq YN globalvar_YN) (setq Bg globalvar_Bg) (setq ht globalvar_ht) (setq RP globalvar_RP) (setq txh1 globalvar_txh1) (setq MinLen globalvar_MinLen) (setq pipetype globalvar_pipetype) ;;;;;;;;;;;;;;;;;;;;end defaults;;;;;;;;;;;;;;;; (setq offst (/ txh1 2)) (setq insut (getvar "insunits")) (setq adoc (vla-get-activedocument (vlax-get-acad-object)) acsp (vla-get-block(vla-get-activelayout adoc))) (vla-startundomark adoc ) (setq txh txh1 prex (getvar "dimdec") ) (while (not sset) (setq sset (ssget '((0 . "*LINE")))) ) (while (setq en (ssname sset 0)) (setq curve (vlax-ename->vla-object en)) ;;(setq txt1 (rtos (vla-get-length curve) 2 2)) (setq txtln (if (= (getvar "measurement") 0) (rtos (vla-get-length curve) 3 2) (rtos (vla-get-length curve) 2 2)) ) (setq txtln (atof txtln)) (if (> txtln MinLen) ;; start if minimum length (progn ;; start progn minimum length (if (= RP "Yes") (progn (if (< 0.5 (rem txtln 1)) (setq txtln (+ txtln 1)) ) (setq txtln (fix txtln)) (setq txtln (rtos (* txtln ht) 2 0)) ) (setq txtln (rtos (* txtln ht) 2 2)) ) (setq LAYERNAME (vla-get-layer curve)) (setq mid (/ (abs (- (vlax-curve-getendparam curve) (vlax-curve-getstartparam curve))) 2.) mp (vlax-curve-getpointatparam curve mid) deriv (vlax-curve-getfirstderiv curve (vlax-curve-getparamatpoint curve mp)) ) (if (zerop (cadr deriv)) (setq ang 0) (setq ang (- (/ pi 2) (atan (/ (car deriv) (cadr deriv))))) ) (if (< (/ pi 2) ang (* pi 1.5)) (setq ang (+ pi ang)) ) ;;; (setq ppt1 (polar mp (+ ang (/ pi 2)) (* txh 0.5)) ;;; ) (setq ppt1 (polar mp (+ ang (/ pi 2)) offst) ) (setq txtpt1 (vlax-3d-point (trans ppt1 1 0))) ;;; (setq txt1 (vla-addtext acsp txt txtpt1 txh)) ;(setq txt (strcat LAYERNAME pipepn)) (setq txt (strcat LAYERNAME " L=" (strcat txtln "m"))) (setq txt (vl-string-subst pipetype "P_" txt)) (setq txt (vl-string-subst "/" "-" txt)) (setq theMText (vla-AddMText mspace txtpt1 (atof "0") txt)) (vla-put-AttachmentPoint theMText acBottomCenter) ;;(vla-put-alignment theMText acAlignmentBottomCenter) ;;(vla-put-textalignmentpoint theMText txtpt1) ;;(vla-put-insertionpoint theMText (vla-get-textalignmentpoint theMText)) (vla-put-rotation theMText ang) (vla-put-Height theMText txh) (if (= Bg "Yes") (progn (vla-put-backgroundfill theMText :vlax-true) (setq dxf_ent (entget (entlast))) (entmod (append dxf_ent '((90 . 1) (63 . 254) (45 . 1.1) (441 . 0)))) ) ) (if (= YN "Pipe") (vlax-put-property theMText 'layer LAYERNAME) ) ;(setq txt1 (vla-addtext acsp txt txtpt1 txh)) ;(vla-put-alignment txt1 acAlignmentBottomCenter) ;(vla-put-textalignmentpoint txt1 txtpt1) ;(vla-put-insertionpoint txt1 (vla-get-textalignmentpoint txt1)) ; (vla-put-rotation txt1 ang) ;(if (= YN "Pipe") ; (vlax-put-property txt1 'layer LAYERNAME) ; ) );; end progn minimum length );; end if minimum length (ssdel en sset) ) (*error* nil) (princ) ) (princ "\n\t---\tStart command with \"DIMLPDET\"\t---") (princ) (or (vl-load-com) (princ)) ;;------------------------------------ code end ----------------------------------;;
    2 points
  2. @Emmanuel Delay one small thing: in the "global variables, defaults" part I've changed the text size default from fixed 2 to the current draing textsize var: (setq globalvar_txh1 (getvar "TEXTSIZE")) ;;(setq globalvar_txh1 2)
    1 point
  3. 1 point
  4. I have moved your thread to the AutoCAD 2D Drafting, Object Properties & Interface Forum. Please post in the most appropriate forum.
    1 point
  5. So you could do this with an if statement (if.. user wants defaults (progn do stuff ) ) ... continue but that isn't what you were asking. You can just write a LISP within a LISP and it should work: Usually these sub routines are defined at the top of the LISP (defun Lisp1 ( / ) (defun LISP2 ( / ) do stuff 2 ) ; end LISP 2 Do stuff Call LISP2 Do more stuff ) ; end As an example (defun c:MyLISP ( / A B C) (defun LISPA ( Z / D) ; define LISPA (Princ Z) ; Do stuff (setq D "\nDone LISPA") D ; return D ) (setq A "Running LISPA") (setq B (LISPA A)) ; run LISPA, set B to be what LISPA returns (not necessary if it doesn't do that) (princ B) (setq A "\nDoing it again") (setq B (LISPA A)) (princ B) (princ) ) ; End MyLISP
    1 point
  6. I tried the first lisp too but didn't work unfortunately. I was hoping to replace the clicking with a window but I guess the command will not allow it. It's okay, I'll learn to live with it. Thank you again mhupp.
    1 point
  7. @mhupp to the rescue, and spot on, as usual. I enjoyed reading the link too, thanks. FYI, in case you don't already know. As in the following screenshot. Should you have Selection Cycling enabled... My selection is ambiguous because of the overlapping leaders within my pick box. The display of those grips on that second leader means that the software is guessing, that is probably the one you intend to select, and it is shown blued out at the top of the list. Should that in fact, be correct, and your intended selection, just hit ENTER and it will be one selected. The presumptive selection will be at the top of the list and filled with blue. Should that not be the one you meant, as you click on other objects displayed on the list, that objects grips will be highlighted.
    1 point
  8. Copy and paste the codes in any text editor eg: NOTEPAD then save it with the extension .lsp ( eg: Test.lsp ) then from AutoCAD call the command: APPLOAD -> Select the Test.lsp file -> press LOAD -> press CLOSE.
    1 point
  9. I think that is letting you know about selection cycling. Turn it off with (setvar 'SELECTIONCYCLING 0)
    1 point
  10. If the command itself is only allowing you to pick one entity at a time. Than the only option might be to make a window selection but then feed them one at a time to the command. see if this works. (defun C:CurSP (/ size ss) (setq size (getstring "\nSize: ")) (if (setq ss (ssget)) (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (command "_.comp2sizespec" ent "" size) ) ) ) (defun C:CurSP (/ size ss) (if (setq ss (ssget)) (command "_.comp2sizespec" ss "") ; see if all at onece works ) )
    1 point
  11. And another that allows a pick of any part of the dimension (defun c:foo (/ e el m p1 p2) (if (and (setq e (car (entsel "\nPick dimension: "))) (progn (vlax-for a (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 (entget e))) ) (and (= "AcDbMText" (vla-get-objectname a)) (setq m (vlax-vla-object->ename a))) ) m ) (setq p1 (cdr (assoc 10 (setq el (entget m))))) (setq p2 (getpoint p1 "\nSpecify second point: ")) ) (entmakex (append (vl-remove-if '(lambda (x) (= 330 (car x))) el) (list (cons 10 p2)))) ) (princ) )
    1 point
  12. As with my recent upload of the STSC_uvVectorMap routine, this updated beta has had not testing in AutoCAD beyond 2018. I've modified the 'PackageContents.xml' to allow loading in later versions, the beta testes will have to inform me of issues. In light of that, these bundles should be considered 'Alpha' versions. Use accordingly. STSC_TextToGeometryBeta_1-2021.bundle.zip
    1 point
  13. Refer to my Prefix/Suffix Text program here.
    1 point
  14. Hi, Something along these codes? (defun c:Test ( / ss in en st) (if (setq ss (ssget "_:L" '((0 . "MTEXT")))) (repeat (setq in (sslength ss)) (setq en (entget (ssname ss (setq in (1- in)))) st (assoc 1 en)) (entmod (subst (cons 1 (strcat (cdr st) "p")) st en)) ) ) (princ) )
    1 point
×
×
  • Create New...