Jump to content

Leaderboard

Popular Content

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

  1. So you plotting from Model space or layout ? Google "plotting Maratovich" has a good package handles lots of combinations. I have plot range etc of layouts of different sizes but not model, only have plot all in model but 1 size. Big hint use layouts.
    2 points
  2. This what i came up with a few weeks back. will work on multiple lines of text or mtext. will create mtext at the current 'textsize variable & keep the formatting. if you don't pick a point it will copy text to the clipboard. ;;----------------------------------------------------------------------------;; ;; COMBINE MULTIPLE TEXT INTO ONE MTEXT (defun c:CMT (/ done lst str) (while (not done) (setvar 'errno 0) (setq e (car (nentsel "\nSelect Text to join: "))) (if (and (= (getvar 'errno) 0) (wcmatch (cdr (assoc 0 (entget e))) "*TEXT") ) (progn (if (not (member (vlax-ename->vla-object e) lst)) (setq lst (cons (vlax-ename->vla-object e) lst)) ) ; end if (redraw e 3) ) (if (= (getvar 'errno) 52) (setq done T) (prompt "\nNothing selected --") ) ) ) (setq lst (reverse lst)) (setq str (vlax-get (car lst) 'TextString)) (setq lst (cdr lst)) (foreach x lst (setq str (strcat str "\\P" (vlax-get x 'TextString))) ) (if (setq pt (getpoint "\nLocation: ")) ;if you pick a point will create mtext if not will copy to clipboard (entmake (list '(0 . "MTEXT") '(100 . "AcDbEntity") '(100 . "AcDbMText") (cons 10 pt) (cons 1 str) '(71 . 5) ;mid center justify ) ) (progn (setq str (vl-string-subst " " "\\P" str)) (vlax-invoke (vlax-get (vlax-get (setq html (vlax-create-object "htmlfile")) 'ParentWindow) 'ClipBoardData) 'setData "Text" str) (vlax-release-object html) ) ) (vla-Regen Drawing acactiveviewport) (princ) )
    1 point
  3. I have a library of entmake routines, so I don't need to copy and paste them every time I want one. get it working once and it will work every time after. Using that instead of your code gives me the below: Try that. Also added a couple of princ to report what the user clicks Problem with your code I think you need the cons 100s: (cons 100 "AcDbEntity")(cons 100 "AcDbMText") (defun M-Text (pt str) (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 1 str))) ) (defun c:comtext () (setq ent1 (entsel "\nSelect first text entity: ")) (princ (setq text1 (cdr (assoc 1 (entget (car ent1)))))) (setq ent2 (entsel "\nSelect second text entity: ")) (princ (setq text2 (cdr (assoc 1 (entget (car ent2)))))) (setq point (getpoint "\nSelect location for combined text: ")) (M-Text point (strcat text1 "\P" text2)) (princ) )
    1 point
  4. You have it all there in my posted code... Look for (inters) function and what follows it...
    1 point
  5. What about if polylines are "invert" so the end to end and start to star will make a self intersecting 3dpolyline
    1 point
  6. This is last version I have on my laptop. Hope it's the latest , not sure. At the end of the main loop I've added the setbylayer command with some remarks. Not sure if its what you need but that's for you to find out. I'm sorry I don't have much time right now , have to deal with the aftermath of afterlife party (my dad , 91) BlockByBlock.lsp
    1 point
  7. Similar, but little more reliable... Untested though... (defun c:conn23dp-planes ( / *error* tttt vertlst wcs initvalueslst ucsf ti ss i pls pl vl pll sp1 ep1 sp2 ep2 li1 li2 ) (defun *error* ( m ) (if wcs (if ucsf (while (not (and (equal (getvar (quote ucsxdir)) (car ucsf) 1e-6) (equal (getvar (quote ucsydir)) (cadr ucsf) 1e-6) (equal (trans (list 0.0 0.0 1.0) 1 0 t) (caddr ucsf) 1e-6) ) ) (exe (list "_.UCS" "_P")) ) ) ) (while (= 8 (logand 8 (getvar (quote undoctl)))) (if (not (exe (list "_.UNDO" "_E"))) (if doc (vla-endundomark doc) ) ) ) (if initvalueslst (mapcar (function apply_cadr->car) initvalueslst) ) (foreach fun (list (quote tttt) (quote vl-load) (quote exe) (quote cmdfun) (quote cmderr) (quote catch_cont) (quote apply_cadr->car) (quote ftoa)) (setq fun nil) ) (if doc (vla-regen doc acactiveviewport) ) (if m (prompt m) ) (princ) ) (defun tttt ( wcs / sysvarpreset sysvarlst sysvarvals ) ;;; wcs (T/nil) ;;; cad, doc, alo, spc - global variables (Visual Lisp main VLA-OBJECT pointers) ;;; vl-load exe cmdfun cmderr catch_cont apply_cadr->car ftoa - library sub functions common for standard template initialization ;;; (defun vl-load nil (or cad (if vlax-get-acad-object (setq cad (vlax-get-acad-object)) (progn (vl-load-com) (setq cad (vlax-get-acad-object)) ) ) ) (or doc (setq doc (vla-get-activedocument cad))) (or alo (setq alo (vla-get-activelayout doc))) (or spc (setq spc (vla-get-block alo))) ) ;;; sometimes not needed to use/initialize AxiveX Visual Lisp extensions - (comment/uncomment) following line ;;; (or (and cad doc alo spc) (vl-load)) (defun exe ( tokenslist ) ( (lambda ( tokenslist / ctch ) (if (vl-catch-all-error-p (setq ctch (cmdfun tokenslist t))) (progn (cmderr tokenslist) (catch_cont ctch) ) (progn (while (< 0 (getvar (quote cmdactive))) (vl-cmdf "") ) t ) ) ) tokenslist ) ) (defun cmdfun ( tokenslist flag / ctch ) ;;; tokenslist - command parameters list of strings ;;; flag - if "t" specified, upon successful execution returns t, otherwise if "nil" specified, return is always nil no matter what outcome of function execution is - it should be successful anyway if specified tokenslist was hardcoded correctly... ;;; (if command-s (if flag (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist)))) flag ctch ) (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command-s) tokenslist))) ctch ) ) (if flag (if (not (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function vl-cmdf) tokenslist)))) flag ctch ) (if (vl-catch-all-error-p (setq ctch (vl-catch-all-apply (function command) tokenslist))) ctch ) ) ) ) (defun cmderr ( tokenslist ) ;;; tokenslist - list of tokens representing command syntax at which used (cmdfun) failed with successful execution ;;; (prompt (strcat "\ncommand execution failure... error at used command tokenslist : " (vl-prin1-to-string tokenslist))) ) (defun catch_cont ( ctch / gr ) (prompt "\nleft mouse click to continue or enter to generate catch error - ESC to break...") (while (and (vl-catch-all-error-p (or ctch (setq ctch (vl-catch-all-apply (function /) (list 1 0))))) (setq gr (grread)) (/= (car gr) 3) (not (equal gr (list 2 13))) ) ) (if (vl-catch-all-error-p ctch) ctch ) ) (defun apply_cadr->car ( sysvarvaluepair / ctch ) (setq ctch (vl-catch-all-apply (function setvar) sysvarvaluepair)) (if (vl-catch-all-error-p ctch) (progn (prompt (strcat "\ncatched error on setting system variable : " (vl-prin1-to-string (vl-symbol-name (car sysvarvaluepair))) " with value : " (vl-prin1-to-string (cadr sysvarvaluepair)))) (catch_cont ctch) ) ) ) (defun ftoa ( n / m a s b ) (if (numberp n) (progn (setq m (fix ((if (< n 0) - +) n 1e-8))) (setq a (abs (- n m))) (setq m (itoa m)) (setq s "") (while (and (not (equal a 0.0 1e-6)) (setq b (fix (* a 10.0)))) (setq s (strcat s (itoa b))) (setq a (- (* a 10.0) b)) ) (if (= (type n) (quote int)) m (if (= s "") m (if (and (= m "0") (< n 0)) (strcat "-" m "." s) (strcat m "." s) ) ) ) ) ) ) (setq sysvarpreset (list (list (quote cmdecho) 0) (list (quote 3dosmode) 0) (list (quote osmode) 0) (list (quote unitmode) 0) (list (quote cmddia) 0) (list (quote ucsvp) 0) (list (quote ucsortho) 0) (list (quote projmode) 0) (list (quote orbitautotarget) 0) (list (quote insunits) 0) (list (quote hpseparate) 0) (list (quote hpgaptol) 0) (list (quote halogap) 0) (list (quote edgemode) 0) (list (quote pickdrag) 0) (list (quote qtextmode) 0) (list (quote dragsnap) 0) (list (quote angdir) 0) (list (quote aunits) 0) (list (quote limcheck) 0) (list (quote gridmode) 0) (list (quote nomutt) 0) (list (quote apbox) 0) (list (quote attdia) 0) (list (quote blipmode) 0) (list (quote copymode) 0) (list (quote circlerad) 0.0) (list (quote filletrad) 0.0) (list (quote filedia) 1) (list (quote autosnap) 1) (list (quote objectisolationmode) 1) (list (quote highlight) 1) (list (quote lispinit) 1) (list (quote layerpmode) 1) (list (quote fillmode) 1) (list (quote dragmodeinterrupt) 1) (list (quote dispsilh) 1) (list (quote fielddisplay) 1) (list (quote deletetool) 1) (list (quote delobj) 1) (list (quote dblclkedit) 1) (list (quote attreq) 1) (list (quote explmode) 1) (list (quote frameselection) 1) (list (quote ltgapselection) 1) (list (quote pickfirst) 1) (list (quote plinegen) 1) (list (quote plinetype) 1) (list (quote peditaccept) 1) (list (quote solidcheck) 1) (list (quote visretain) 1) (list (quote regenmode) 1) (list (quote celtscale) 1.0) (list (quote ltscale) 1.0) (list (quote osnapcoord) 2) (list (quote grips) 2) (list (quote dragmode) 2) (list (quote lunits) 2) (list (quote pickstyle) 3) (list (quote navvcubedisplay) 3) (list (quote pickauto) 3) (list (quote draworderctl) 3) (list (quote expert) 5) (list (quote auprec) 6) (list (quote luprec) 6) (list (quote pickbox) 6) (list (quote aperture) 6) (list (quote osoptions) 7) (list (quote dimzin) 8) (list (quote pdmode) 35) (list (quote pdsize) -1.5) (list (quote celweight) -1) (list (quote cecolor) "BYLAYER") (list (quote celtype) "ByLayer") (list (quote clayer) "0") ) ) (setq sysvarlst (mapcar (function car) sysvarpreset)) (setq sysvarvals (mapcar (function cadr) sysvarpreset)) (setq sysvarvals (vl-remove nil (mapcar (function (lambda ( x ) (if (getvar x) (nth (vl-position x sysvarlst) sysvarvals)) )) sysvarlst ) ) ) (setq sysvarlst (vl-remove-if-not (function (lambda ( x ) (getvar x) )) sysvarlst ) ) (setq initvalueslst (apply (function mapcar) (cons (function list) (list sysvarlst (mapcar (function getvar) sysvarlst) ) ) ) ) (apply (function mapcar) (cons (function setvar) (list sysvarlst sysvarvals ) ) ) (while (= 8 (logand 8 (getvar (quote undoctl)))) (if (not (exe (list "_.UNDO" "_E"))) (if doc (vla-endundomark doc) ) ) ) (if (not (exe (list "_.UNDO" "_M"))) (if doc (vla-startundomark doc) ) ) (if wcs (if (= 0 (getvar (quote worlducs))) (progn (setq ucsf (list (getvar (quote ucsxdir)) (getvar (quote ucsydir)) (trans (list 0.0 0.0 1.0) 1 0 t) ) ) (exe (list "_.UCS" "_W")) ) ) ) wcs ) (defun vertlst ( poly / n p pl ) (if (and poly (not (vlax-erased-p poly))) (progn (setq n (1+ (fix (+ 0.1 (vlax-curve-getendparam poly))))) (while (<= 0 (setq n (1- n))) (setq p (vlax-curve-getpointatparam poly (float n))) (if (not (equal p (car pl) 1e-3)) (setq pl (cons p pl)) ) ) ) ) pl ) (setq wcs (tttt t)) ;;; starting "library" template sub function - initialization ;;; (if (setq ss (ssget "_:L" (list (cons 0 "*POLYLINE")))) (progn (setq ti (car (_vl-times))) (repeat (setq i (sslength ss)) (setq pls (cons (ssname ss (setq i (1- i))) pls)) ) (while (setq pl (car pls)) (setq vl (vertlst pl)) (exe (list "_.UCS" "_3P" "_non" (car vl) "_non" (cadr vl) "_non" (caddr vl))) (setq pll (vl-some (function (lambda ( x ) (if (vl-every (function (lambda ( y ) (equal 0.0 (caddr (trans y 0 1)) 1e-6) )) (vertlst x) ) x ) )) (vl-remove pl pls) ) ) (setq vl nil) (setq sp1 (vlax-curve-getstartpoint pl) ep1 (vlax-curve-getendpoint pl)) (setq sp2 (vlax-curve-getstartpoint pll) ep2 (vlax-curve-getendpoint pll)) (if (inters sp1 sp2 ep1 ep2) (progn (setq li1 (entmakex (list (cons 0 "LINE") (cons 10 sp1) (cons 11 ep2) ) ) ) (setq li2 (entmakex (list (cons 0 "LINE") (cons 10 sp2) (cons 11 ep1) ) ) ) ) (progn (setq li1 (entmakex (list (cons 0 "LINE") (cons 10 sp1) (cons 11 sp2) ) ) ) (setq li2 (entmakex (list (cons 0 "LINE") (cons 10 ep1) (cons 11 ep2) ) ) ) ) ) (exe (list "_.JOIN" (ssadd li1 (ssadd pl (ssadd li2 (ssadd pll)))) "")) (exe (list "_.UCS" "_P")) (setq pls (vl-remove pl pls) pls (vl-remove pll pls)) ) (prompt "\nElapsed time : ") (prompt (ftoa (- (car (_vl-times)) ti))) (prompt " milliseconds...") (prompt "\nFor UNDO - type \"UNDO\" - \"Back\" option...") ) ) (*error* nil) ) HTH. M.R.
    1 point
  8. Hi, here I share with you who are new to autocad. This command reference in autocad can be used as a common basis. Command AutoCAD.xlsx
    1 point
  9. Try this mod: ;; Scale About Center - Lee Mac (defun c:sac ( / ll sel obj scl ur ) (if (and (setq scl 2 ) (ssget "_:L") ) (progn (vlax-for obj (setq sel (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))) (if (null (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'll 'ur)))) (vla-scaleentity obj (vlax-3D-point (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (vlax-safearray->list ll) (vlax-safearray->list ur) ) ) scl ) ) ) (vla-delete sel) ) ) (princ) ) (vl-load-com) (princ)
    1 point
  10. I use Plot to Layout in all Page Setups for plotting and have a second Page Setup for PDF for each of them. Need functional Page Setups for Publishing anyway. Have QuickPlot & QuickPDF macros to quickly plot any layout without any other input. Nothing reduces drawing time better than good templates!
    1 point
  11. You should consider switching to annotative dimensions so they'd display the same at different scales in MS and the same drawn in PS. Rather than end up with dimensions with varying gap & arrow sizes you could add a dimension style exactly how you want and set that style to all your dimensions.
    1 point
  12. No, you can use a fraction or decimal not both. There's a rational numbering system and a decimal numbering system, the one you want doesn't exist. You could enter 'CAL at the command line then enter 8/0.1234567 to get 64.8000473 returned.
    1 point
  13. If you want all the dimension styles you might need to add this function somewhere: (defun tablesearch ( s / d r) ;;List Dimstyles (while (setq d (tblnext s (null d))) (setq r (cons (cdr (assoc 2 d)) r)) ) ) and to loop through the list something like this: (foreach x (tableSearch "dimstyle") --- do stuff (princ "\n") (princ x) ; for example ) ; end foreach That isn't what I was going to say though, I have found that adjusting the text sizes a lot can make the spacing and arrows out or proportion, the LISP I use does this with dimstyles rather than MHUPPs entmod method - you might want to search for that as well. For example a text size of 250 dwarfs an arrow size of 2.5 MHUPP is pretty good with this stuff and might modify his for example to put arrow size to the same as text size to show how to build up his code to add more stuff (I don't know the code for 'arrow size' )
    1 point
  14. Hello everyone, I'm a conditioning-cooling technician. I've been trying to learn autolisp and write an autolisp program for about two years. My program is about air duct calculation and drawing. I draw the air duct route as a single line. I write the air flow rate on the airdiffizor places. The program calculates the air flow rate in each part, resizes it according to the equal friction method, and draws the model space. I want the user to be able to select some parameters for the drawing. I created a DCL for this. Part number (toogle), layer (popup_list) color (popup_list) text height (edit_box) . The user should be able to set the attributes (layer, color, text height) of the text he wants to print from here. What I want to do is: 1- The layer popup list should be the list of layers in the active drawing. 2- The color popup list should be like the popup in the properties toolbar. I would be grateful to anyone who can help. Thank you. my code for dcl: Cizparam : dialog { label ="Çizim Parametreleri"; width = 30; height = 20 ; : boxed_column { label ="Yazdırma Seçenekleri"; :row { : column { : row { : toggle { key = "Pndim_tog"; label = "Parça Numarası " ; alignment = centered ;}} : row { : toggle { key = "Kndim_tog"; label = "Kanal Ebadı " ; alignment = centered ;}} : row { : toggle { key = "AFdim_tog"; label = "Hava Debisi " ; alignment = centered ;}} : row { : toggle { key = "Padim_tog"; label = "Basınc Kaybı " ; alignment = centered ;}} : row { : toggle { key = "Vldim_tog"; label = "Hava Hızı " ; alignment = centered ;}} : row { : toggle { key = "Ftdim_tog"; label = "Fittings Adı " ; alignment = centered ;}} } : column { : row { : popup_list { label = "Layer:" ; key = "PnoLay_lst"; alignment = centered ; value = "1" ;}} : row { : popup_list { label = "Layer:" ; key = "KnELay_lst"; alignment = centered ; value = "0" ;}} : row { : popup_list { label = "Layer:" ; key = "AflLay_lst"; alignment = centered ; value = "0" ;}} : row { : popup_list { label = "Layer:" ; key = "PamLay_lst"; alignment = centered ; value = "0" ;}} : row { : popup_list { label = "Layer:" ; key = "VelLay_lst"; alignment = centered ; value = "0" ;}} : row { : popup_list { label = "Layer:" ; key = "FttLay_lst"; alignment = centered ; value = "0" ;}} } : column { : row { : popup_list { label = "Color:" ; key = "PnoClr_lst"; alignment = centered ; value = "8" ;}} : row { : popup_list { label = "Color:" ; key = "KnEClr_lst"; alignment = centered ; value = "8" ;}} : row { : popup_list { label = "Color:" ; key = "AflClr_lst"; alignment = centered ; value = "8" ;}} : row { : popup_list { label = "Color:" ; key = "PamClr_lst"; alignment = centered ; value = "8" ;}} : row { : popup_list { label = "Color:" ; key = "VelClr_lst"; alignment = centered ; value = "8" ;}} : row { : popup_list { label = "Color:" ; key = "FttClr_lst"; alignment = centered ; value = "8" ;}} } : column { : row { : edit_box { key = "Pno_eb"; label = "Yazı Yüksekliği :" ; edit_width = 3; fixed_width = true; allow_accept = false; alignment = centered ;}} : row { : edit_box { key = "KnE_eb"; label = "Yazı Yüksekliği :" ; edit_width = 3; fixed_width = true; allow_accept = false; alignment = centered ;}} : row { : edit_box { key = "Afl_eb"; label = "Yazı Yüksekliği :" ; edit_width = 3; fixed_width = true; allow_accept = false; alignment = centered ;}} : row { : edit_box { key = "Pam_eb"; label = "Yazı Yüksekliği :" ; edit_width = 3; fixed_width = true; allow_accept = false; alignment = centered ;}} : row { : edit_box { key = "Vel_eb"; label = "Yazı Yüksekliği :" ; edit_width = 3; fixed_width = true; allow_accept = false; alignment = centered ;}} : row { : edit_box { key = "Ftt_eb"; label = "Yazı Yüksekliği :" ; edit_width = 3; fixed_width = true; allow_accept = false; alignment = centered ;}} } } : row { width = 50; fixed_width = true; alignment = centered ; : button { key = "Accept"; label = "Tamam"; width = 15; fixed_width = true; alignment = left; is_default = true; is_cancel = false; mnemonic = "T"; } : button { key = "Cancel"; label = "Iptal"; width = 15; fixed_width = true; alignment = left; is_default = false; is_cancel = true; mnemonic = "I"; } : button { key = "Hlp"; label = "Yardım"; width = 15; fixed_width = true; alignment = left; is_default = false; mnemonic = "Y"; } } } } // dialog end. And lsp: (defun c:Cpr ( / LayL ClrL Dclid_Cp CzPar) (setq LayL (list "MK-HV Kanal SUPPLY" "MK-HV Kanal FRESH" "MK-HV Kanal RETURN" "MK-HV Kanal EGZOST" "MK-HV Kanal YAZI") ClrL (list "ByLayer" "ByBlock" "1 Red" "2 Yellow" "3 Green" "4 Cyan" "5 Blue" "6 Magenta" "7 White" "Select Color...")) (setq Dclid_Cp (load_dialog "DrwParam.DCL")) (if (not (new_dialog "Cizparam" Dclid_Cp))(exit) (progn (start_list "PnoLay_lst")(mapcar 'add_list LayL)(end_list) ; Parça numarası yazısı layeri ( Part Number Text Layer) (start_list "PnoClr_lst")(mapcar 'add_list ClrL)(end_list) ; Parça numarası yazı rengi ( Part number text layer color) (start_list "KnELay_lst")(mapcar 'add_list LayL)(end_list) ; Parça Ebadı yazısı ( Part Dimension Text Layer) (start_list "KnEClr_lst")(mapcar 'add_list ClrL)(end_list) ; Parça Ebadı yazı rengi ( Part Dimension text layer color) (start_list "AflLay_lst")(mapcar 'add_list LayL)(end_list) ; Hava debisi yazısı ( Airvolume Text Layer) (start_list "AflClr_lst")(mapcar 'add_list ClrL)(end_list) ; Hava debisi yazı rengi ( Airvolume text layer color) (start_list "PamLay_lst")(mapcar 'add_list LayL)(end_list) ; Basınc kaybı yazısı ( Pressure lose Text Layer) (start_list "PamClr_lst")(mapcar 'add_list ClrL)(end_list) ; Basınc kaybı yazı rengi ( Pressure lose text layer color) (start_list "VelLay_lst")(mapcar 'add_list LayL)(end_list) ; Hava hızı yazısı ( AirVelocity Text Layer) (start_list "VelClr_lst")(mapcar 'add_list ClrL)(end_list) ; Hava hızı yazı rengi ( AirVelocity text layer color) (start_list "FttLay_lst")(mapcar 'add_list LayL)(end_list) ; Fitingsno yazısı ( Fittings Number Text Layer) (start_list "FttClr_lst")(mapcar 'add_list ClrL)(end_list) ; Fitingsno yazı rengi ( Fittings Number text layer color) (action_tile "Accept" "(done_dialog 1)") (action_tile "Cancel" "(done_dialog 0)") (setq CzPar (start_dialog)) (unload_dialog Dclid_Cp) (if (= CzPar 1) (alert "Çizim Parametreleri Kaydedildi.!!")) (if (= CzPar 0) (alert "Çizim Parametreleri Kaydedilmedi.!!")) ) ) ) kanalProg.mp4
    1 point
×
×
  • Create New...