Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 10/17/2023 in all areas

  1. @Aftertouch, below is a working solution that I've come up with. It creates and deletes .dwl3 files the same way that AutoCAD handles .dwl and .dwl2 files. It also checks for a .dwl3 file each time you open a drawing and will warn you if someone else has it open, forcing you to close. Hope you find it useful! My acaddoc.lsp contains the following: (load "H:\\CAD\\C3D\\LSP\\dwl3.lsp") and dwl3.lsp looks like this: ;;----- Popup - Lee Mac --------------------------------- ;; A wrapper for the WSH popup method to display a message box prompting the user. ;; ttl - [str] Text to be displayed in the pop-up title bar ;; msg - [str] Text content of the message box ;; bit - [int] Bit-coded integer indicating icon & button appearance ;; Returns: [int] Integer indicating the button pressed to exit (defun LM:popup ( ttl msg bit / wsh rtn ) (if (setq wsh (vlax-create-object "wscript.shell")) (progn (setq rtn (vl-catch-all-apply 'vlax-invoke-method (list wsh 'popup msg 0 ttl bit))) (vlax-release-object wsh) (if (not (vl-catch-all-error-p rtn)) rtn) ) ) ) ;;----- Read DWL3 ----------------------------------------- (defun c:readdwl3file () (setq dwl (strcat (getvar "Dwgprefix") (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)) ".dwl3")) (setq file (findfile dwl)) (if file (progn (setq data "") (setq file (open dwl "r")) (if file (setq data (read-line file)) ) (close file) (if data (setq data (strcase (vl-string-trim " " data))) (setq data "none") ) ) (setq data "none") ) data ) ;;----- Write DWL3 ---------------------------------------- (defun c:writedwl3file () (setq user (getvar "loginname")) (setq dwg (strcat (getvar "Dwgprefix") (getvar "dwgname"))) (setq dwl (strcat (getvar "Dwgprefix") (substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)) ".dwl3")) (setq dwlowner (c:readdwl3file)) (if (null dwlowner) (setq dwlowner "unknown") ) (if (not (findfile dwl)) (progn (if (setq des (open dwl "w")) (progn (write-line user des) (close des) ) (princ "") ) ) (and (saveclosereactor) (and (LM:popup "AutoCAD Alert" (strcat dwg " is currently in use by " dwlowner ". Please open the file read-only.") (+ 0 16 4096)) (command "close" "No"))) ) ) ;;----- Delete DWL3 --------------------------------------- (defun c:deletedwl3file () (setq dwl (strcat (getvar "Dwgprefix")(substr (getvar "dwgname") 1 (- (strlen (getvar "dwgname")) 4)) ".dwl3")) ; Excluded the extension from dwgname (if (findfile dwl) (vl-file-delete dwl) ) (princ) ) ;;----- SaveClose Reator - Lee Mac (Modified) ----------------- (defun SaveCloseReactor nil (vl-load-com) ( (lambda ( data / react ) (if (setq react (vl-some (function (lambda ( reactor ) (if (eq data (vlr-data reactor)) reactor) ) ) (cdar (vlr-reactors :vlr-editor-reactor) ) ) ) (if react (if (vlr-added-p react) (vlr-remove react) (vlr-add react) ) ) (setq react (vlr-editor-reactor data (list (cons :vlr-beginclose 'CustomCloseCallBack) (cons :vlr-savecomplete 'CustomSaveCallBack) ) ) ) ) (setq *error* nil) ; Suppress any potential error messages (if (vlr-added-p react) (setq status "SaveClose reactor is on") (setq status "SaveClose reactor is off") ) ) "SaveClose-Reactor" ) ) (defun CustomCloseCallBack (reactor arguments) (if (= (getvar "WRITESTAT") 1) (c:deletedwl3file) ) ; Deletes .dwl3 file when closing or quitting a read-write file (vlr-remove reactor) ; Ensure the reactor is removed after it's triggered ) (defun CustomSaveCallBack (reactor arguments) (and (c:deletedwl3file) (c:writedwl3file)) ; Saves a new .dwl3 when saving ) ;;----------------------------------------------------------- (saveclosereactor) (if (= (getvar "WRITESTAT") 1) (c:writedwl3file) ) ; Writes .dwl3 file when opening a read-write file
    1 point
  2. I am running a Nvidia geoforce GTX no problems, I have though set up when running cad make the used graphics card be Nvidia when running Acad or Bricscad not say Internal Intel. Trying to remember where it is to set. You can turn off graphics acceleration sometimes that is a problem. Another how much ram do you have, want 16gb to work properly. What processor Intel or AMD ?
    1 point
  3. If the alert is a consistent message never changes, then on page 1 you will see where I mentioned using VSLIDE with Delay yes this works. The slide can be anything including background color.
    1 point
  4. By way of example of colours in a DCL, this will write the letter 'H' in front of a highlighted background. Can't work out another way just now to do it another way. Text can be any of 256 colours so can the background. Essentially creates an image tile, colours in a portion of is an writes the text as a vector graphic - so for this letter 'H' there are 9 lines of code. Do the same for a simple highlighted word and lots of lines of code. Note that the vector points are from top left down rather than the usual bottom left up. There is probably a smarter way to create the text, have a library of the letters and insert at a point... but that isn't for me today. (defun c:VectorLetters ( / fo fname dcl_id Message1) (Defun MyA ( origin BgCol TxCol ImgTile / ) (start_image ImgTile) (fill_image (- origin 1) 0 (+ origin 9) 12 BgCol) ;;x1 y1 x2 y2 colour ;;x1 y1 x2 y2 colour. Upside down? No decimals (vector_image (+ origin 0) 12 (+ origin 3) 0 TxCol) (vector_image (+ origin 1) 12 (+ origin 4) 0 TxCol) (vector_image (+ origin 7) 12 (+ origin 5) 0 TxCol) (vector_image (+ origin 6) 12 (+ origin 4) 0 TxCol) (vector_image (+ origin 3) 6 (+ origin 6) 6 TxCol) (vector_image (+ origin 3) 7 (+ origin 6) 7 TxCol) (end_image) ) (Defun MyE ( origin BgCol TxCol ImgTile / ) (start_image ImgTile) (fill_image (- origin 1) 0 (+ origin 9) 12 BgCol) ;;x1 y1 x2 y2 colour ;;x1 y1 x2 y2 colour. Upside down? No decimals (vector_image (+ origin 0) 0 (+ origin 0) 12 TxCol) (vector_image (+ origin 1) 0 (+ origin 1) 12 TxCol) (vector_image (+ origin 0) 0 (+ origin 7) 0 TxCol) (vector_image (+ origin 0) 1 (+ origin 7) 1 TxCol) (vector_image (+ origin 0) 5 (+ origin 5) 5 TxCol) (vector_image (+ origin 0) 6 (+ origin 5) 6 TxCol) (vector_image (+ origin 0) 12 (+ origin 7) 12 TxCol) (vector_image (+ origin 0) 11 (+ origin 7) 11 TxCol) (end_image) ) (Defun MyF ( origin BgCol TxCol ImgTile / ) (start_image ImgTile) (fill_image (- origin 1) 0 (+ origin 9) 12 BgCol) ;;x1 y1 x2 y2 colour ;;x1 y1 x2 y2 colour. Upside down? No decimals (vector_image (+ origin 0) 0 (+ origin 0) 12 TxCol) (vector_image (+ origin 1) 0 (+ origin 1) 12 TxCol) (vector_image (+ origin 0) 5 (+ origin 5) 5 TxCol) (vector_image (+ origin 0) 6 (+ origin 5) 6 TxCol) (vector_image (+ origin 0) 0 (+ origin 7) 0 TxCol) (vector_image (+ origin 0) 1 (+ origin 7) 1 TxCol) (end_image) ) (Defun MyH ( origin BgCol TxCol ImgTile / ) ;;WIDTHS 8 HEIGHT 12 (start_image ImgTile) (fill_image (- origin 1) 0 (+ origin 9) 12 BgCol) ;;x1 y1 x2 y2 colour ;;x1 y1 x2 y2 colour. Upside down? No decimals (vector_image (+ origin 0) 0 (+ origin 0) 12 TxCol) (vector_image (+ origin 1) 0 (+ origin 1) 12 TxCol) (vector_image (+ origin 0) 5 (+ origin 7) 5 TxCol) (vector_image (+ origin 0) 6 (+ origin 7) 6 TxCol) (vector_image (+ origin 6) 0 (+ origin 6) 12 TxCol) (vector_image (+ origin 7) 0 (+ origin 7) 12 TxCol) (end_image) ) (Defun MyI ( origin BgCol TxCol ImgTile / ) ;;WIDTHS 8 HEIGHT 12 (start_image ImgTile) (fill_image (- origin 1) 0 (+ origin 9) 12 BgCol) ;;x1 y1 x2 y2 colour ;;x1 y1 x2 y2 colour. Upside down? No decimals (vector_image (+ origin 2) 0 (+ origin 2) 12 TxCol) (vector_image (+ origin 3) 0 (+ origin 3) 12 TxCol) (vector_image (+ origin 0) 0 (+ origin 5) 0 TxCol) (vector_image (+ origin 0) 1 (+ origin 5) 1 TxCol) (vector_image (+ origin 0) 11 (+ origin 5) 11 TxCol) (vector_image (+ origin 0) 12 (+ origin 5) 12 TxCol) (end_image) ) (Defun MyO ( origin BgCol TxCol ImgTile / ) ;;WIDTHS 8 HEIGHT 12 (start_image ImgTile) (fill_image (- origin 1) 0 (+ origin 9) 12 BgCol) ;;x1 y1 x2 y2 colour ;;x1 y1 x2 y2 colour. Upside down? No decimals (vector_image (+ origin 0) 2 (+ origin 0) 10 TxCol) (vector_image (+ origin 1) 2 (+ origin 1) 10 TxCol) (vector_image (+ origin 6) 2 (+ origin 6) 10 TxCol) (vector_image (+ origin 7) 2 (+ origin 7) 10 TxCol) (vector_image (+ origin 2) 0 (+ origin 5) 0 TxCol) (vector_image (+ origin 1) 1 (+ origin 6) 1 TxCol) (vector_image (+ origin 1) 11 (+ origin 6) 11 TxCol) (vector_image (+ origin 2) 12 (+ origin 5) 12 TxCol) (vector_image (+ origin 2) 10 (+ origin 2) 10 TxCol) (vector_image (+ origin 2) 2 (+ origin 2) 2 TxCol) (vector_image (+ origin 5) 10 (+ origin 5) 10 TxCol) (vector_image (+ origin 5) 2 (+ origin 5) 2 TxCol) (end_image) ) (Defun MyU ( origin BgCol TxCol ImgTile / ) ;;WIDTHS 8 HEIGHT 12 (start_image ImgTile) (fill_image (- origin 1) 0 (+ origin 9) 12 BgCol) ;;x1 y1 x2 y2 colour ;;x1 y1 x2 y2 colour. Upside down? No decimals (vector_image (+ origin 0) 0 (+ origin 0) 10 TxCol) (vector_image (+ origin 1) 0 (+ origin 1) 10 TxCol) (vector_image (+ origin 6) 0 (+ origin 6) 10 TxCol) (vector_image (+ origin 7) 0 (+ origin 7) 10 TxCol) (vector_image (+ origin 1) 11 (+ origin 6) 11 TxCol) (vector_image (+ origin 2) 12 (+ origin 5) 12 TxCol) (vector_image (+ origin 2) 10 (+ origin 2) 10 TxCol) (vector_image (+ origin 5) 10 (+ origin 5) 10 TxCol) (end_image) ) (setq Alert_Type "Alert") ;Single Word alert type header. No special characters (setq Message1 "Message") ;Many Words ;;;;;;;;;;; ;;Start DCL (setq fo (open (setq fname (vl-filename-mktemp "Alert" (getvar "TEMPPREFIX") ".dcl")) "w")) ;;Header (write-line "SelLays : dialog {" fo) (write-line " key = \"Alert\";" fo) (write-line (strcat " label = " Alert_type "; ") fo) (write-line " spacer;" fo) ;;Message (write-line " :boxed_column { width = 50;" fo) (write-line " :row {alignment = top;" fo) (write-line (strcat " : text { key = \"UserText1\"; label = " Message1 "; width = 5; alignment = left;}") fo) ;1st image (write-line " : image { key = MyImg; width = 0; height = 1; color = dialog_background;}" fo) ; create an image, colour 0 (write-line " }" fo) ; end row (write-line " }" fo) ; end boxed column ;2nd image (write-line " :boxed_column { width = 50;" fo) (write-line " :row {alignment = top;" fo) (write-line " : image { key = AnotherImg; width = 0; height = 1; color = dialog_background;}" fo) ; create an image, colour 0 (write-line " }" fo) ; end row (write-line " }" fo) ; end boxed column ;;Buttons (write-line " :boxed_column { width = 50;" fo) (write-line " : button { key = \"accept\"; label = \"OK\"; is_default = true; is_cancel = true; fixed_width = true; width = 15; }" fo) (write-line " }" fo) ; end boxed column (write-line "}" fo) ; end dialog (close fo) (setq dcl_id (load_dialog fname)) (if (not (new_dialog "SelLays" dcl_id)) (exit) ) ;;End DCL definition ;;Image Texts;; x POSTION, BACGROUND COLOUR, TEXT COLOUR, IMAGE TILE ;;Define here which letter you want to use in order (MyA 0 256 7 "MyImg") (MyE 9 256 7 "MyImg") (MyI 18 256 7 "MyImg") (MyO 25 2 1 "MyImg") (MyU 34 9 7 "MyImg") (MyF 43 9 7 "MyImg") (MyH 52 9 7 "MyImg") (MyA 0 2 1 "AnotherImg") (MyH 9 3 5 "AnotherImg") (MyH 18 4 9 "AnotherImg") ;;Action Tiles (action_tile "OK" "(done_dialog 1)") ;Run DCL (start_dialog) (unload_dialog dcl_id) (vl-file-delete fname) MyLayer )
    1 point
  5. A good task to start learning lisp, look at code examples, entsel line 1, get midpoint line1 entsel line2 get midpoint line2 get length of line get midpoint again of the 2 lines angle mid1 mid2 use polar to work out the end points of the centre line get start and end points of the lines draw line to the ends of the lines Have a go much better than just waiting for someone to provide an answer. Plenty here to help.
    1 point
×
×
  • Create New...