Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 10/04/2019 in all areas

  1. oh darn Emmanuel beat me to it, awell , at least (unlike me) he probably knows what he was doing lol....oh , that's the command , because don't want to redefine my own LL command (load lisp) (defun alg-ang (obj pnt) (angle '(0. 0. 0.) (vlax-curve-getfirstderiv obj (vlax-curve-getparamatpoint obj pnt)))) (defun C:LoL (/ *error* acsp adoc ang fld midp mtx rot sset txtpt) (defun *error* (msg) (if (vl-position msg '("console break" "Function cancelled" "quit / exit abort")) (princ "Error!") (princ msg)) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object))) (princ) ) (or adoc (setq adoc (vla-get-activedocument (vlax-get-acad-object)))) (if (and (= (getvar "tilemode") 0) (= (getvar "cvport") 1)) (setq acsp (vla-get-paperspace adoc)) (setq acsp (vla-get-modelspace adoc))) (vla-startundomark adoc) (if (setq sset (ssget "_:L" (list (cons 0 "point")))) (foreach obj (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex sset)))) ;(if (not (eq "AcDbArc" (vla-get-objectname obj))) ; (setq midp (vlax-curve-getclosestpointto obj (vlax-curve-getpointatparam obj ; (/ (- (vlax-curve-getEndParam obj)(vlax-curve-getStartParam obj)) 2)))) ; (setq midp (vlax-curve-getclosestpointto obj (vlax-curve-getpointatdist obj ; (/ (vla-get-arclength obj) 2))))) ;(setq ang (alg-ang obj midp)) (setq ang 0 midp (vlax-safearray->list (vlax-variant-value (vla-get-coordinates obj)))) (if (> pi ang (/ pi 2)) (setq ang (+ ang pi))) (if (> (* pi 1.5) ang pi) (setq ang (+ ang pi))) (setq rot (+ ang (/ pi 2))) (setq txtpt (polar midp (* pi 0.25) (if (zerop (getvar "dimtxt")) 2.5 (getvar "dimtxt")))) (setq fld (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-objectid obj)) ">%).Layer>%")) (setq mtx (vlax-invoke acsp 'AddMText midp 0.0 fld)) (vlax-put mtx 'AttachmentPoint (vlax-put mtx 'InsertionPoint txtpt) (vlax-put mtx 'Rotation ang) ) ) (princ) ) (princ "\n\t\t\tType LoL to label curves with layer name\t") (prin1) (vl-load-com) time (almost) to enjoy the weekend gr. R.
    2 points
  2. What is FONTALT? What is FONTMAP? When you run STYLE do any Fonts have a yellow triangle with a /!\? Sounds like you use TTFs and AutoCAD doesn't see them, so you may need to address this as a Windows problem and delete and reinstall the Windows Fonts. https://knowledge.autodesk.com/support/autocad/troubleshooting/caas/sfdcarticles/sfdcarticles/Some-TrueType-fonts-not-listed.html
    2 points
  3. Like this? Command LL (defun M-Text (pt str ht) (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 10 pt) (cons 40 ht) (cons 1 str))) ) (defun c:ll ( / points i point layer ip ht) (setq ht 2.5) ;; Text height. Feel free to pick your desired height (princ "\nSelect points: ") (setq points (ssget (list (cons 0 "POINT")))) (setq i 0) (repeat (sslength points) (setq layer (cdr (assoc 8 (entget (ssname points i))))) (setq ip (cdr (assoc 10 (entget (ssname points i))))) (M-Text ip layer ht) (setq i (+ i 1)) ) (princ) ) Or maybe you want the Mtext in the layer of the point? (Or any other extras?)
    1 point
  4. Hi Lee the version posted is different to what is now on your web site so trying to work out the rgx value.
    1 point
  5. Try this revision to my TEST3 command. It currently only reads the ACI color codes from the original layers, but could be updated to capture the other color codes (truecolor, colorbook) as well. Let me know if that is necessary. (defun C:test3 ( / cl cnt el en la llst lt nlst ol suff) (setq ss (ssget) cnt 0) (repeat (sslength ss) (setq el (entget (ssname ss cnt)) la (cdr (assoc 8 el)) cnt (1+ cnt) ) (if (not (member la llst))(setq llst (cons la llst))) ) (if (setq suff (getstring "\nEnter suffix for layers: ")) (progn (setq nlst (mapcar '(lambda (x) (strcat x "-" suff)) llst) cnt 0) (foreach i nlst (setq ol (tblsearch "LAYER" (nth 1 llst)) cl (cdr (assoc 62 ol)) lt (cdr (assoc 6 ol)) ) (command "._-layer" "_N" i "_c" cl i "_l" lt i "") (setq cnt (1+ cnt)) ) (setq cnt 0) (repeat (sslength ss) (setq en (ssname ss cnt) el (entget en) la (cdr (assoc 8 el)) el (subst (cons 8 (strcat la "-" suff)) (assoc 8 el) el) cnt (1+ cnt) ) (entmod el) ) ) ) (princ) )
    1 point
  6. Try one of these 2 functions. The 1st one (TEST2) just renames the layers. The 2nd one (TEST3) creates new layers and moves the selection to the new layers (Note - Currently the color and linetypes of the original layers are not replicated in TEST3). (defun C:test2 ( / cnt el la llst nlst ss suff) (setq ss (ssget) cnt 0) (repeat (sslength ss) (setq el (entget (ssname ss cnt)) la (cdr (assoc 8 el)) cnt (1+ cnt) ) (if (not (member la llst))(setq llst (cons la llst))) ) (if (setq suff (getstring "\nEnter suffix for layers: ")) (progn (setq nlst (mapcar '(lambda (x) (strcat x "-" suff)) llst) cnt 0) (foreach i llst (command "._-rename" "_LA" i (nth cnt nlst)) (setq cnt (1+ cnt)) ) ) ) (princ) ) (defun C:test3 ( / cnt el en la llst nlst ss suff) (setq ss (ssget) cnt 0) (repeat (sslength ss) (setq el (entget (ssname ss cnt)) la (cdr (assoc 8 el)) cnt (1+ cnt) ) (if (not (member la llst))(setq llst (cons la llst))) ) (if (setq suff (getstring "\nEnter suffix for layers: ")) (progn (setq nlst (mapcar '(lambda (x) (strcat x "-" suff)) llst) cnt 0) (foreach i nlst (command "._-layer" "_N" i "") (setq cnt (1+ cnt)) ) (setq cnt 0) (repeat (sslength ss) (setq en (ssname ss cnt) el (entget en) la (cdr (assoc 8 el)) el (subst (cons 8 (strcat la "-" suff)) (assoc 8 el) el) cnt (1+ cnt) ) (entmod el) ) ) ) (princ) )
    1 point
  7. Neither file (DWG / DXF) appear to have a coordinate system assigned. Command: CGEOCS That should echo the assigned name. You need to assign a known system to the drawing using ... Command: ADESETCRDSYS
    1 point
  8. OK. Attached is updated AMT2L lisp. This handles 4 of the 5 leaders in your drawing. The exception is a leader with an attachment point set to 1 where the others are set to 4. This can be compensated by setting the fuzz to 3, but the leader moves. It is possible to keep the leader as is and move the mtext. What would you like to do? assocMText2Leader2.lsp
    1 point
×
×
  • Create New...