Leaderboard

Just a comment provided the layer exists, you can use a (cons 8 "Linework") in the entmake to make object on a certain layer.

First of all happy new year for everybody. Now about this app , RlxPaste. I often have need to copy some objects from one dwg to another. Although I allready have written a 'perfect' app for that , all my colleagues use it and I didn't want to add my junk symbols to it. So I came up with this app , which allows you to simply create symbols on the fly for local use. I think / hope the interface is self explanatory. You can control the grid in the setup dialog and you can select the folder where you save your symbols. Btw , double click to insert and if you want to delete item , click delete button and then click on image to delete. You can add a complete folder and its subfolders at once with the button Add Folder in the main dialog. This is usefull when you have for example a cd from a vendor or client with their company symbols. Hope it is usefull. gr. Rlx RlxPaste.dcl RlxPaste.LSP

Check if it works. I don't have a PC in front of me so I edited it from my smartphone. ; DET.LSP Enlarge an Area for a Detail (c)1992, Victor V. Jensen ; - Modified for Release 11. ; [DET.LSP] ; Global variables: s#v, olderr. (prompt "\nLoading functions") ; details error function (defun deterr (S / A L) (if (/= S "Function cancelled") (princ (strcat "\nError: " S))) (command nil) (command ".UNDO" "B") (foreach A s#v (if (= (car A) "CLAYER") (command "LAYER" "S" (cadr A) "") (setvar (car A) (cadr A)) )) (setq *error* olderr s#v nil olderr nil) (princ) ) (princ ".") ; sscross function (defun sscross (/ S1 S2) (setq S1 (ssget "C" P2 P3) S2 (ssget "W" P2 P3)) (if (/= (sslength S1) (sslength S2)) (progn (command ".SELECT" S1 "R" S2 "") (ssget "p")) ) ; if ) (princ ".") ; explode function (defun explode (EN / A C E I L R S E1 E2 E3 S1 S2) (setq S2 (ssadd)) (while (setq EN (entnext EN)) (setq E (entget EN) ET (cdr (assoc 0 E)) E1 (cdr (assoc 41 E)) E2 (cdr (assoc 42 E)) E3 (cdr (assoc 43 E)) ) (if (= HL 1) (redraw EN 3)) (cond ((= ET "INSERT") (if (= (abs E1) (abs E2) (abs E3)) (if (or (< E1 0) (< E2 0) (< E3 0)) (progn (setq A (entlast) C (cdr (assoc 10 E)) I (cdr (assoc 2 E)) L (cdr (assoc 50 E)) R (car C) S (cadr C) ) (entdel EN) (setq S1 (ssadd)) (command ".INSERT" (strcat "*" I) C (abs E1) 0) (while (setq A (entnext A)) (setq S1 (ssadd A S1))) (if (< E1 0) (command ".MIRROR" S1 "" C (list R (+ 10 S)) "Y")) (if (< E2 0) (command ".MIRROR" S1 "" C (list (+ 10 R) S) "Y")) (if (/= L 0) (command ".ROTATE" S1 "" C (* (/ 180 pi) L))) ) (command ".EXPLODE" EN) ) (ssadd EN S2) )) ; if ((member ET '("POLYLINE" "DIMENSION")) (command ".EXPLODE" EN)) ((ssadd EN S2)) ) ; cond ) ; while (setq S1 (ssget "C" P2 P3)) (command ".ERASE" S2 "R" S1 "") ) (princ ".") ; id function (defun id (E / EN ET) (setq EN (cdr (assoc -1 E)) ET (cdr (assoc 0 E))) (if (= ET "ARC") (list EN ET (cdr (assoc 50 E)) (cdr (assoc 51 E))) (list EN ET) ) ; if ) (princ ".") ; trim output function (defun op (EN ET) (if (not (and (<= (- (car P2) 1E-6) (car ET) (+ (car P3) 1E-6)) (<= (- (cadr P2) 1E-6) (cadr ET) (+ (cadr P3) 1E-6)) )) (progn (command (list EN ET)) T) ) ; if ) (princ ".") ; trim function (defun trim (/ I L EN ET EA SA S1 TM E C R D90 D270) (while OK (setq OK nil I 0 S1 (sscross) L (if S1 (sslength S1) 0)) (if (> L 0) (command ".TRIM" C2 "")) (repeat L (setq EN (ssname S1 I) E (entget EN) ET (cdr (assoc 0 E)) I (1+ I)) (if (not (member (id E) TM)) (progn (setq TM (cons (id E) TM)) (cond ((= ET "LINE") (op EN (cdr (assoc 10 E))) (op EN (cdr (assoc 11 E)))) ((= ET "CIRCLE") (setq C (cdr (assoc 10 E)) R (cdr (assoc 40 E)) OK T) (cond ((op EN (list (+ R (car C)) (+ 0.0 (cadr C))))) ((op EN (list (+ 0.0 (car C)) (+ R (cadr C))))) ((op EN (list (+ (- R) (car C)) (+ 0.0 (cadr C))))) ((op EN (list (+ 0.0 (car C)) (+ (- R) (cadr C))))) )) ; cond ((= ET "ARC") (setq C (cdr (assoc 10 E)) R (cdr (assoc 40 E)) SA (cdr (assoc 50 E)) EA (cdr (assoc 51 E)) OK T D90 (/ pi 2) D270 (* pi 1.5) ) (if (> SA EA) (setq EA (+ EA (* pi 2)))) (cond ((op EN (polar C SA R))) ((op EN (polar C EA R))) ((or (<= SA 0.0 EA) (<= SA (* pi 2) EA)) (op EN (polar C 0.0 R))) ((or (<= SA D90 EA) (<= SA 0.0 EA)) (op EN (polar C D270 R))) ((or (<= SA pi EA) (<= SA (* pi 3) EA)) (op EN (polar C pi R))) ((or (<= SA D270 EA) (<= SA (* pi 3.5) EA)) (op EN (polar C D270 R))) )) ; cond )) ; cond )) ; if (if (> L 0) (command "")) ) ; while ) (princ ".") ; main program (defun C:DET (/ A E I L R DT EN ET HL OK TM C1 C2 S1 P0 P1 P2 P3 P4 P5) (setq DT (* (getvar "DIMSCALE") (getvar "DIMTXT")) HL (getvar "HIGHLIGHT") olderr *error* *error* deterr A '("HIGHLIGHT" "BLIPMODE" "OSMODE" "CLAYER" "ORTHOMODE") s#v (mapcar '(lambda (L) (list L (getvar L))) A) osmant (getvar "osmode") ) (setvar "CMDECHO" 0) (setvar "BLIPMODE" 0) (setvar "OSMODE" 0) (command ".UNDO" "M" ".LAYER" "S" "0" "ON" "0" "") (while (= OK nil) (initget 1) (setq P1 (getpoint "\nDetail centerpoint: ")) (princ "\nEncircle detail: ") (command ".CIRCLE" P1 PAUSE) (setq C1 (entlast) R (cdr (assoc 40 (entget C1))) L (sqrt (* (expt R 2) 2)) P2 (append (list (+ (car P1) R) (cadr P1))) A (angle P2 P1) P2 (polar P1 (* A 1.25) L) P3 (polar P1 (* A 0.25) L) S1 (ssget "C" P2 P3) ) (if (> (sslength S1) 1) (setq OK T) (progn (setq OK nil) (princ "\nNothing selected!") (command ".ERASE" C1 "")) ) ; if ) ; while (setvar "ORTHOMODE" 0) (princ "\nLocate detail: ") (command ".COPY" C1 "" P1 PAUSE) (command ".ERASE" C1 "") (setq P4 (getvar "LASTPOINT") C2 (entlast)) (setvar "HIGHLIGHT" 0) (command ".COPY" S1 "" P1 P4) (setvar "HIGHLIGHT" HL) (setq P2 (polar P4 (* A 1.25) L) P3 (polar P4 (* A 0.25) L) EN C2) (princ "\nProcessing data...please wait.") (explode EN) (trim) (setq S1 (sscross) L (if S1 (sslength S1) 0) I 0) (repeat L (setq EN (ssname S1 I) E (entget EN) ET (cdr (assoc 0 E)) I (1+ I)) (if (member ET '("LINE" "CIRCLE" "ARC")) (entdel EN)) ) (command "_REGENALL" "") ;(setvar "HIGHLIGHT" 0) (initget 6) ;(if (setq HL (getreal "\nScale factor <1.0000>: ")) (command ".SCALE" "C" P2 P3 "" P4 (setq HL 1.0)) ;) (setq P3 (polar P4 (* A 1.5) (cdr (assoc 40 (entget C2)))) P4 (polar P3 (* A 1.5) (* DT 2)) P5 (polar P4 (* A 1.5) (* DT 2)) ; TM (strcase (strcat "DETAIL-" (getstring " DETAIL-"))) ; ET (strcat "SCALE: " (getstring " SCALE: ")) ) ; (initget 1) (setq P2 (getpoint P1 "\nLocate leader text: ")) ; (if (or (<= (angle P1 P2) (/ A 2)) (>= (angle P1 P2) (* A 1.5))) ;--------------------------------- Release 11 --------------------------------- ; (progn (setq I "ML" P3 (polar P2 0.0 (* DT 2)) P0 (polar P2 0.0 (* DT 2.5)))) ; (progn (setq I "MR" P3 (polar P2 A (* DT 2)) P0 (polar P2 A (* DT 2.5)))) ;) ; if ;(command ".LINE" P1 P2 P3 "" ".TRIM" C1 "" P1 "" ".TEXT" I P0 DT "0" TM ; ".TEXT" "M" P4 (* DT 1.5) "0" (strcat "%%U" TM) ; ".TEXT" "M" P5 DT "0" ET ;) ;(foreach A s#v ; (if (= (car A) "CLAYER") ; (command ".LAYER" "S" (cadr A) "") (setvar (car A) (cadr A)) ;)) (setq *error* olderr s#v nil olderr nil) (setvar "osmode" osmant) (princ) ) ; end program (princ "loaded.") Basically: -it was necessary to save the state of the variable 'OSNAP' and restore it at the end -the part of the code where the scale is requested has been cancelled and the value 1.0 has been assigned directly

Yes, the (cons 8 "Linework") can be added to entmake, but after executing this line of code: (if (not (tblsearch "LAYER" "Linework")) (command "-layer" "m" "Linework" "") (command "-layer" "s" "Linework" "") ) it will be automatically set to current layer "Linework" and there is no needs for (cons 8 "Linework") inside the entmake.

Hi @ediba, Try with this modification: (defun c:AddLevelLine () (setvar "OSMODE" 1) ; Set osnap to endpoint ; Get points (setq pt1 (getpoint "\nSelect first point: ")) (setq pt2 (getpoint pt1 "\nSelect second point: ")) ; Force horizontal line by using same Y-coordinate (setq pt2 (list (car pt2) (cadr pt1) 0)) ; Prompt for level number (setq levelnum (getstring "\nEnter level number: ")) ; Create the line ;;(command "_layer" "s" "Linework" "") ;;(command "_line" pt1 pt2 "") ; Check if layer "Linework" already exist or not, if it's not, it will make the new layer and set to be "Linework" (if (not (tblsearch "LAYER" "Linework")) (command "-layer" "m" "Linework" "") (command "-layer" "s" "Linework" "") ) ;;; Create the line (entmake (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt2))) ; Calculate text positions (setq text_string (strcat "LEVEL " levelnum)) ; Create single-point text entities ;;;(command "_dtext" "j" "bc" pt1 0.2 0 text_string) ;;;(command "_dtext" "j" "bc" pt2 0.2 0 text_string) ;;; This few lines from below is better than from above '(command "_dtext" ......)' (setq def_height 0.20 rotation 0 horizontal_justification 1 vertical_justification 1 ) ;;; Instead of using "command", I prefer to use "entmake" (entmake (list (cons 0 "TEXT") (cons 10 pt1) (cons 40 def_height) (cons 1 text_string) (cons 50 rotation) (cons 11 pt1) (cons 72 horizontal_justification) (cons 73 vertical_justification))) (entmake (list (cons 0 "TEXT") (cons 10 pt2) (cons 40 def_height) (cons 1 text_string) (cons 50 rotation) (cons 11 pt2) (cons 72 horizontal_justification) (cons 73 vertical_justification))) (princ) ) Also, you can improve your code by adding somes checkings when user need to insert values (insted of (getstring "\nEnter level number: ") you can use (getint "\nEnter level number: ")), than you can convert it to string using "itoa" (strcat "LEVEL " (itoa levelnum)), localize the variables (defun c:AddLevelLine ( / pt1 pt2 levelnum ......) ......), etc. Best regards.

something like this (defun c:AddLevelLine () (setvar "OSMODE" 1) ; Set osnap to endpoint (setvar 'ORTHOMODE 1) ; Get points (setq pt1 (getpoint "\nSelect first point: ")) (setq pt2 (getpoint pt1 "\nSelect second point: ")) ; Prompt for level number (setq levelnum (getstring "\nEnter level number: ")) ; Create the line (command "_layer" "s" "Linework" "") (command "_line" pt1 pt2 "") ; Create single-point text entities (command"text" "j" "bc" pt1 "0.2" "0" (strcat "LEVEL " levelnum)) (command "txt2mtxt" (entlast)"") (princ) (setvar 'ORTHOMODE 0) )

Hi, Written a tool for replacing (updating) blocks. Had some spare time untill my boss recently used the W-word again (work , yak!) Anywayz , its a prototype so I'm not sure its stable and safe yet because I only did some lab testing. I hope it will be usefull. Not sure if I will be able to work on it further any time soon because I still have a few ideas and wishes. gr. Rlx RlxBlk manual.doc RlxBlk.lsp RlxBlk.dcl

I wrote this program like four years ago (just for fun / exercise) and maybe used it once or twice so as we say here on Mars : guaranteed to the doorstep If it works : , if it doesn't ... As usual never wrote a manual so have fun experimenting. RlxBlockSync.lsp