Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 08/26/2021 in all areas

  1. off of what @tombu posted was able to update the code to work with true color. it will error if its 256 color coded. (defun c:vv (/ oldlayer sub ss ss1 layname laylst gelay ltlay colay newl) (setvar 'cmdecho 0) (setq oldlayer (getvar 'clayer)) (setq sub (getstring "\n Give prefix to layername: ")) (setq ss (ssget "_:L")) (if (= ss nil) (princ "\nNo elements selected") (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (if (not (vl-position (setq layname (cdr (assoc 8 (entget e)))) laylst)) (setq laylst (cons layname laylst)) ) ) ) (if (not (= laylst nil)) (foreach lay laylst (setq gelay (entget(tblobjname "LAYER" lay)) ltlay (cdr (assoc 6 gelay)) newl (strcat sub "-" lay) ) (if (setq colay (cdr (assoc 420 gelay))) (setq colay (LM:True->RGB colay) colay (strcat (nth 0 colay) "," (nth 1 colay) "," (nth 2 colay)) ) (setq colay (cdr (assoc 62 gelay))) ) (if (not (tblsearch "Layer" newl)) (vl-cmdf "-Layer" "M" newl "C" colay "" "L" ltlay "" "") ) (sssetfirst nil ss) (setq SS1 (ssget (list (cons 8 lay)))) (prompt (strcat"\nElements coverted to " newl " layer")) (vl-cmdf "chprop" SS1 "" "la" newl "") ) ) (setvar 'clayer oldlayer) (setvar "cmdecho" 1) (princ) ) ;; True -> RGB - Lee Mac ;; Args: c - True Colour (defun LM:True->RGB ( c ) (list (itoa (lsh (lsh (fix c) 08) -24)) (itoa (lsh (lsh (fix c) 16) -24)) (itoa (lsh (lsh (fix c) 24) -24)) ) )
    1 point
  2. Command: (entget(tblobjname "LAYER" "parnal")) returns ((-1 . <Entity name: 25e8f2e95b0>) (0 . "LAYER") (330 . <Entity name: 25e8f2b9020>) (5 . "10973") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "parnal") (70 . 5) (62 . -195) (420 . 8078013) (6 . "Continuous") (290 . 0) (370 . 30) (390 . <Entity name: 25eeb0735a0>) (347 . <Entity name: 25e8f2c1370>) (348 . <Entity name: 0>)) This way seems to work!
    1 point
  3. Existence of DXF code 420 indicates True Color, test for that and use vla-get-Color & vl-catch-all-apply 'vla-put-Color if it does. Haven't tried it on a Layer table entry though.
    1 point
  4. Nice try! You were close (defun c:wow (/ ang co-ord d1 d2 ent i mp oldang p1 p2 p3 rec) (vl-load-com) (setq oldang (getvar 'aunits)) (setvar 'aunits 3) (setq i 0) (setq ent (ssget '((0 . "LWPOLYLINE") (90 . 4) (-4 . "&=") (70 . 1)))) (if ent (repeat (sslength ent) ;; (setq rec (vlax-ename->vla-object (ssname ent i))) (setq rec (ssname ent i)) ;; (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car rec))))) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget rec)))) (setq p1 (nth 0 co-ord) p2 (nth 1 co-ord) p3 (nth 2 co-ord) ) (setq d1 (distance p1 p2) d2 (distance p2 p3) ) (setq mp (mapcar '* (mapcar '+ p1 p3) '(0.5 0.5))) (if (> d1 d2) (setq ang (angle p1 p2)) (setq ang (angle p2 p3)) ) (command "text" "J" "MC" mp 250 ang "ABC") ;; (setq i i+1) (setq i (1+ i)) ) ) ;; (setvar 'aunits (oldang)) (setvar 'aunits oldang) (princ) )
    1 point
  5. As the lisp doesn't create or import the blocks it inserts I'm assuming they're already in the drawing by way of a default template drawing. It would need to be attached before we could attempt to debug the lisp. (IF (and (>= (ANGLE POI POI1) (/ 11 7)) (<= (ANGLE POI POI1) (/ 33 7)) ) (SETQ MH "MH") (SETQ MH "MH") ) sets global variable MH to the string "MH" whether the if statement is True or not then (command "-insert" MH attempts to insert a block MH which is actually defined as a string. I find it hard to believe this code ever worked. Lisp hasn't changed that much.
    1 point
  6. Try this has a homework attached google text readable hint lee-mac. ; simple text at mid of rectang alanh AUG 2021 (defun c:wow ( / rec co-ord p1 p2 p3 and d1 d2) (setq oldang (getvar 'aunits)) (setvar 'aunits 3) (while (setq rec (entsel "\npick rectang Enter to exit")) (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (car rec))))) (setq p1 (nth 0 co-ord) p2 (nth 1 co-ord) p3 (nth 2 co-ord) ) (setq d1 (distance p1 p2) d2 (distance p2 p3) ) (setq mp (mapcar '* (mapcar '+ p1 p3) '(0.5 0.5))) (if (> d1 d2) (setq ang (angle p1 p2)) (setq ang (angle p2 p3)) ) (command "text" mp 2.5 ang "abc") ) (setvar 'aunits (oldang)) (princ) )
    1 point
  7. Another, supply with Document Object: (defun DeleteLayout ( doc name / item ) (if (not (vl-catch-all-error-p (setq item (vl-catch-all-apply 'vla-item (list (vla-get-layouts doc) name)) ) ) ) (not (vla-delete item)) ) ) e.g.: (DeleteLayout (vla-get-activedocument (vlax-get-acad-object)) "Layout1") Returns T if Layout is deleted, otherwise nil if Layout is not found.
    1 point
×
×
  • Create New...