Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 04/05/2024 in all areas

  1. To add to this, over about 6 lines my head spins around a little so I tend to always note what the closing brackets are for which really helps. Also when building the code I'll add the closing bracket straight after with the note to keep the order right. Same applies with DCL codes Simple example by way of explanation, a silly routine. ;;1.: (setq acount 0) (while (< acount 10) ) ;; end while 2.: (setq acount 0) (while (< acount 10) (if (= acount 5) ) ; end if (setq acount (+ acount 1)) ) ;; end while 3.: (setq acount 0) (while (< acount 10) (if (= acount 5) (progn (princ "Thats 5!") ) ; end progn (progn ) ; end progn ) ; end if (setq acount (+ acount 1)) ) ;; end while 4.: (setq acount 0) (while (< acount 10) (if (= acount 5) (progn (princ "\nThats 5!") ) ; end progn (progn (princ (strcat "\n" (rtos acount 2 2) " isn't 5" )) ; end strcat, end princ ) ; end progn ) ; end if (setq acount (+ acount 1)) ) ;; end while
    1 point
  2. This is a simple counter of the block definitions not the blocks in the drawing. "There are 0 XREF's in this drawing" or "There are 16 XREF's in this drawing" ;;--------------------------------------------------------------------------------;; ;; displays a message of how many xref files are in the drawing ;; https://www.cadtutor.net/forum/topic/83071-check-if-there-are-attachment-xrefs-in-dwg/ (defun c:XREF-CHECK (/ i) (vl-load-com) (setq i 0) (vlax-for blk (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (if (= (vla-get-isxref blk) :vlax-true) (setq i (1+ i) ) ) (alert strcat("\nThere are " (rtos i 2 0) " XREF in this drawing")) (princ) ) You could modify this to build a list to of names and check to see if those blocks are in the drawing. (overlay ?)
    1 point
  3. Just when you think you can't find anything weirder in AutoCAD... Xrefs are defined as blocks in AutoCAD. There may be an easier way to do it, but this one is guaranteed. Get the entity that defines the xref from the the block table. DXF code 70 defines the type of block it is (even though it's not a block). If the value of code 70 includes the value 8 (it's bitwise, that is, you add values together), it's an overlay, while a 4 is an attachment. Apparently, you can have 4 and 8 at the same time, which means xref with overlay. In other words, the 4 (bit 3) means it's an xref, the 8 (bit 4) means it's also an overlay. So you would check for bit 3 on and bit 4 off. There is a VBA command, vla-get-IsXref, but that only tells you whether the block is an xref, not whether it's an overlay or an attachment.
    1 point
  4. @Kvlar Just FYI - I have been editing my post above just in case you looked at it. I made some mistakes in my first draft and corrected them. If you are having problems still, check to make sure on the time of my last post edit. EDIT: My last edit again - updated above. I need to test code more thoroughly before posting LOL. I hope my post above is not too confusing. I am trying to help you understand what the code does.
    1 point
  5. No worries. Happy to help out. Most of who I know here are always very helpful and always share their knowledge. Which is why I like this site. Learn something new each time.
    1 point
  6. I used (command "PLAN" "") to switch from a non-world UCS to world, and it worked. It wasn't in a function, though. Is it possible that you need to run a Regen as well?
    1 point
  7. Another for lines and plines is pick inside the objects and use Bpoly this will make a new pline which you can get a center point. After making it and using it just erase it. If you have text already or add text 1st and use the insertion point for pt, then move text. (command "bpoly" (getpoint '\nPick point inside ")) (setq obj (vlax-ename->vla-object (entlast))) (setq pt (osnap (vlax-curve-getStartPoint obj) "gcen")) (vla-delete obj)
    1 point
  8. Had the same question near enough the other day.... I've added txt2cent to what I posted, the LISP below is a bit old, probably needs a rewrite but is tried and tested txt2rect will centre the text between 2 user selected points and txt2circ will centre the text on a circle ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c:txt2rect ( / ptc centretext) (setq ptc (rectcentre)) (txt2centre ptc) ) (defun c:txt2circ ( / ptc) (setq ptc (circcentre)) (txt2centre ptc) ) (defun c:txt2cent ( / ptc) (setq ptc (cent)) (txt2centre ptc) ) (defun txt2centre ( ptc / txtset alignment myrotation Edata ptx pty mycons NewInsData NewData entlist entwidth newwidth elist sel endloop enttype txt) ;; From Box Text LISP ;; Text Box - gile / Lee Mac ;; Returns an OCS point list describing a rectangular frame surrounding ;; the supplied text or mtext entity with optional offset ;; enx - [lst] Text or MText DXF data list ;; off - [rea] offset (may be zero) (defun text-box-off ( enx off / bpt hgt jus lst ocs org rot wid ) (cond ( (= "TEXT" (cdr (assoc 00 enx))) (setq bpt (cdr (assoc 10 enx)) rot (cdr (assoc 50 enx)) lst (textbox enx) lst (list (list (- (caar lst) off) (- (cadar lst) off)) (list (+ (caadr lst) off) (- (cadar lst) off)) (list (+ (caadr lst) off) (+ (cadadr lst) off)) (list (- (caar lst) off) (+ (cadadr lst) off)) ) ) ) ( (= "MTEXT" (cdr (assoc 00 enx))) (setq ocs (cdr (assoc 210 enx)) bpt (trans (cdr (assoc 10 enx)) 0 ocs) rot (angle '(0.0 0.0) (trans (cdr (assoc 11 enx)) 0 ocs)) wid (cdr (assoc 42 enx)) hgt (cdr (assoc 43 enx)) jus (cdr (assoc 71 enx)) org (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid)) (0.0)) (cond ((member jus '(1 2 3)) (- hgt)) ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0)) ) lst (list (list (- (car org) off) (- (cadr org) off)) (list (+ (car org) wid off) (- (cadr org) off)) (list (+ (car org) wid off) (+ (cadr org) hgt off)) (list (- (car org) off) (+ (cadr org) hgt off)) ) ) ) ) (if lst ( (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst)) (list (list (cos rot) (sin (- rot)) 0.0) (list (sin rot) (cos rot) 0.0) '(0.0 0.0 1.0) ) ) ) ) (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark thisdrawing) (princ "\nSelect Text") (while (and (/= enttype "TEXT")(/= enttype "MTEXT")(/= enttype "ATTDEF")) (setq txt (car (entsel ""))) (setq Edata (entget txt)) (setq enttype (cdr (assoc 0 Edata))) ) (setq txtset (ssadd)) (setq txtset (ssadd txt txtset)) ; (setq txtset (ssget '((0 . "*TEXT")))) ; (setq Edata (entget (ssname txtset 0))) (setq myrotation (cdr (assoc 50 Edata))) (setq Newdata (subst (cons 50 0) (assoc 50 Edata) Edata) ) (entmod Newdata) (setq alignment (gettextalign txtset)) ;; (setq ali (nth 0 (assoc 73 Edata))) (setq ptx (nth 0 (assoc 10 Edata))) (setq pty (nth 1 (assoc 10 Edata))) (command "_.justifytext" txtset "" "MC") (setq Edata (entget (ssname txtset 0))) (setq mycons 10) (if (/= 0 (nth 1 (cdr (assoc 11 Edata))))(setq mycons 11)) (setq NewInsData (cons mycons ptc) ) (setq Newdata (subst NewInsdata (assoc mycons Edata) Edata) ) (if (= "TEXT" (cdr (assoc 0 Edata))) (progn (setq Newdata (subst (cons 50 myrotation)(assoc 50 Newdata) Newdata)) ;; (setq Newdata (subst (cons 73 ali)(assoc 73 Newdata) Newdata)) (entmod Newdata) ) ) (if (= "ATTDEF" (cdr (assoc 0 Edata))) (progn (entmod Newdata) ) ) (if (= "MTEXT" (cdr (assoc 0 Edata))) ;;mtext etc. (progn (setq entlist Edata) ;;could be Edata (setq entwidth entlist) (setq newwidth (cdr (assoc 42 entlist))) ;;text line width assoc 41 for mtext 'box' width (if (< newwidth (cdr (assoc 42 entwidth)))(setq newwidth (+ MWidth newwidth))) (if (= (cdr (assoc 41 entlist)) 0)(setq newwidth 0)) ;;fix for zero width mtexts ;;(setq MTextCoords (text-box-off MyEntGet 1)) ;;(setq MTextWidth (Distance (car MTextCoords) (cadr MTextCoords))) ;;(setq MyEntGet (subst (cons 41 MTextWidth) (assoc 41 MyEntGet) MyEntGet)) (setq elist (subst (cons 41 newwidth)(assoc 41 Edata) Edata)) ;;if txt this is width factor, mtext its text width (setq elist (subst (cons mycons ptc)(assoc mycons elist) elist)) (setq elist (subst (cons 50 myrotation)(assoc 50 elist) elist)) (entmod elist) ) ) (command "_.justifytext" txtset "" alignment) (vla-endundomark thisdrawing) (princ) ) (defun rectcentre ( / pt1 pt2 ptx pty ptz ptc) (setq pt1 (getpoint "\nPick Corner 1")) ;; (setq myent (car (nentselp pt1))) ;; (princ (cdr (assoc 0 (entget myent)))) ;; how to check if a circle or closed polyline selected (setq pt2 (getpoint "\nPick Corner 2")) (setq ptx (+ (nth 0 pt1) (/ (- (nth 0 pt2)(nth 0 pt1)) 2)) ) (setq pty (+ (nth 1 pt1) (/ (- (nth 1 pt2)(nth 1 pt1)) 2)) ) (setq ptz (+ (nth 2 pt1) (/ (- (nth 2 pt2)(nth 2 pt1)) 2)) ) (setq ptc (list ptx pty ptz)) ptc ) (defun circcentre ( / circ ent ptc enttype) (princ "\nSelect Circle") (while (/= enttype "CIRCLE") (setq circ (car (entsel ""))) (setq ent (entget circ)) (setq enttype (cdr (assoc 0 ent))) ) ; (setq circ (ssget '((0 . "CIRCLE")))) ; (setq ent (entget (ssname circ 0))) (setq ptc (assoc 10 ent)) (setq ptc (list (nth 1 ptc)(nth 2 ptc)(nth 3 ptc))) ptc ) (defun cent (/ obj rgn pt) ;;https://www.cadtutor.net/forum/topic/71044-center-of-polygon/ (if (and (setq obj (car (entsel "\nSelect object to calculate centroid: "))) (setq spc (vlax-ename->vla-object (cdr (assoc 330 (entget obj))))) (setq obj (vlax-ename->vla-object obj)) (= 'list (type (setq rgn (vl-catch-all-apply 'vlax-invoke (list spc 'addregion (list obj)))))) ) (progn (setq pt (vlax-get (setq rgn (car rgn)) 'centroid)) (vl-catch-all-apply 'vla-delete (list rgn)) ;; (entmake (list '(0 . "POINT") (cons 10 pt) '(8 . "centroid"))) ) ) pt ) ;;;;get centre point of text (defun LM:txtcentre ( / b e centretext) (cond ( (not (setq e (car (nentsel))))) ( (not (setq b (LM:textbox (entget e)))) (princ "\nInvalid object selected - please select text, mtext or attribute.") ) ( (entmake (list '(000 . "POINT") (cons 010 (trans (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car b) (caddr b)) e 0)) (assoc 210 (entget e)) ) ) ) ( (princ "\nUnable to create central point.")) ) (setq centretext (trans (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car b) (caddr b)) e 0) ) (list centretext e) ) ;; Text Box - Lee Mac (based on code by gile) ;; Returns the bounding box of a text, mtext, or attribute entity (in OCS) (defun LM:textbox ( enx / bpt hgt jus lst ocs org rot wid ) (cond ( (and (= "ATTRIB" (cdr (assoc 000 enx))) (= "Embedded Object" (cdr (assoc 101 enx))) ) (LM:textbox (cons '(000 . "MTEXT") (member '(101 . "Embedded Object") enx))) ) ( (cond ( (wcmatch (cdr (assoc 000 enx)) "ATTRIB,TEXT") (setq bpt (cdr (assoc 010 enx)) rot (cdr (assoc 050 enx)) lst (textbox enx) lst (list (car lst) (list (caadr lst) (cadar lst)) (cadr lst) (list (caar lst) (cadadr lst))) ) ) ( (= "MTEXT" (cdr (assoc 000 enx))) (setq ocs (cdr (assoc 210 enx)) bpt (trans (cdr (assoc 010 enx)) 0 ocs) rot (angle '(0.0 0.0) (trans (cdr (assoc 011 enx)) 0 ocs)) wid (cdr (assoc 042 enx)) hgt (cdr (assoc 043 enx)) jus (cdr (assoc 071 enx)) org (list (cond ((member jus '(2 5 8)) (/ wid -2.0)) ((member jus '(3 6 9)) (- wid)) (0.0)) (cond ((member jus '(1 2 3)) (- hgt)) ((member jus '(4 5 6)) (/ hgt -2.0)) (0.0)) ) lst (list org (mapcar '+ org (list wid 0)) (mapcar '+ org (list wid hgt)) (mapcar '+ org (list 0 hgt))) ) ) ) ( (lambda ( m ) (mapcar '(lambda ( p ) (mapcar '+ (mxv m p) bpt)) lst)) (list (list (cos rot) (sin (- rot)) 0.0) (list (sin rot) (cos rot) 0.0) '(0.0 0.0 1.0) ) ) ) ) ) ;; Matrix x Vector - Vladimir Nesterovsky ;; Args: m - nxn matrix, v - vector in R^n (defun mxv ( m v ) (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m) ) ;; Matrix x Vector - Vladimir Nesterovsky ;; Args: m - nxn matrix, v - vector in R^n (defun mxv ( m v ) (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m) ) (defun gettextalign ( txtset / txtset Edata ptx_old pty_old pty_new ptx_new mycons) ;; (setq txtset (ssget '((0 . "*TEXT")))) (setq Edata (entget (ssname txtset 0))) (setq mycons 10) (if (/= 0 (nth 1 (cdr (assoc 11 Edata))))(setq mycons 11)) (setq ptx_old (nth 1 (assoc mycons Edata))) (setq pty_old (nth 2 (assoc mycons Edata))) (command "_.justifytext" txtset "" "MC") (setq Edata (entget (ssname txtset 0))) (setq ptx_new (nth 1 (assoc mycons Edata))) (setq pty_new (nth 2 (assoc mycons Edata))) (if (< ptx_old ptx_new)(setq alignx "L")) (if (> ptx_old ptx_new)(setq alignx "R")) (if (= ptx_old ptx_new)(setq alignx "C")) (if (> pty_old pty_new)(setq aligny "T")) (if (< pty_old pty_new)(setq aligny "B")) (if (= pty_old pty_new)(setq aligny "M")) (setq xyalign (strcat aligny alignx)) (command "_.justifytext" txtset "" xyalign) xyalign )
    1 point
  9. A quick one: (defun c:pp( / ss) (setq ss (ssget '((0 . "LINE")))) (setq x nil y nil z nil) (repeat (setq i (sslength ss)) (setq el (entget (ssname ss (setq i (1- i)))) a10 (cdr (assoc 10 el)) a11 (cdr (assoc 11 el)) x (cons (car a10) (cons (car a11) x)) y (cons (cadr a10) (cons (cadr a11) y)) z (cons (caddr a10) (cons (caddr a11) z)) ) ) (setq cx (* 0.5 (+ (apply 'max x) (apply 'min x))) cy (* 0.5 (+ (apply 'max y) (apply 'min y))) cz (* 0.5 (+ (apply 'max z) (apply 'min z))) ) (setq txt (entget (car (entsel "select text")))) (entmod (subst (list 10 cx cy cz) (assoc 10 txt) txt)) )
    1 point
  10. You may want to do a little research on object-oriented programming (OOP). Once you understand inheritance, abstraction, encapsulation, and polymorphism, it's easier to see how the pieces of an OOP system fit together. For instance, an AutoCAD object is more like a class, while an entity is more like an instance of a class. The class defines how the entity can behave, but the instance tells you how a particular entity does behave. Visual LISP is a dialect of AutoLISP that works in an Integrated Development Environment (IDE). It's supposed to make programming easier. Visual LISP objects aren't higher level, they're the same objects in a different space. The libraries are necessary to run code in that space. Visual LISP, in effect, adds a layer of abstraction so that you don't get stuck in the weeds of AutoLISP. Commands that start with vla- are part of Visual LISP. Commands that start with vlax- are part of the ActiveX system, which allows you to access other types of documents, such as Word or Excel. ActiveX commands are at once more generic and more powerful. Unfortunately, you can only use ActiveX with Windows. If you want to retrieve the layer of an object, you can do it either way, but notice the difference: (vla-get-layer 'obj) (vlax-get-property 'obj Layer) With the first command, you get the layer of an object. With the second one, you can get any property of that object, even if the property isn't related to AutoCAD. You can use either one, depending on how you feel about context, readability, and consistency.
    1 point
  11. See this post on the Autodesk .NET forums. If I'm reading it correctly, in .NET you can use COM, which uses either early binding or late binding. I guess you've inadvertently used early binding. Here's another article that uses API instead of COM. You may want to go that route if you haven't gotten locked into COM. If none of that helps, give us more information about your issue. Welcome to the forum!
    1 point
×
×
  • Create New...