Jump to content

Leaderboard

Popular Content

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

  1. Try a re-order (command "-hatch" "P" "ANSI31" 0.03 0.0 "S" ename "" "")
    2 points
  2. @LaneH Microsoft wont fix this, sjnce the lock on the DWL is a Autodesk problem. Autodesk wont fix this, since they wanna sell the Construction Cloud and say its a Microsoft problem.
    1 point
  3. ; PAIRING - 2023.10.18 exceeds (defun C:PAIRING (/ acdoc *error* oldecho @DelAllUrl ss ssl index pairingnumber ent obj each checkout 1len 1deg ss2 ss2l index2 ent2 obj2 each2 checkout2 2len 2deg 1sp 1ep 2sp 2ep flag each2 checkout2 each3 checkout3 pair11 pair12 pair21 pair22 line1 line2 midpt midlinelen midpt1 midpt2 midline ) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))) (defun *error* (msg) (if (/= msg "Function cancelled") (princ (strcat "\nError: " msg)) ) (vla-EndUndoMark acdoc) (princ) ) (defun dtr (a) (setq x (* pi (/ a 180.0)))) (defun rtd (a) (setq x (/ (* a 180) pi))) (defun @DelAllUrl (/ ss n k en) (setq ss (ssget "_X" '((0 . "LINE")))) (setq n (sslength ss)) (setq k 0) (while (<= 1 n) (setq en (ssname ss k)) (vlax-for x (vla-get-hyperlinks (vlax-ename->vla-object en)) (vla-delete x)) (setq n (- n 1)) (setq k (+ k 1)) ) (princ) ) (vla-startundomark acdoc) (@DelAllUrl) (if (not (tblsearch "ltype" "Centerx2")) (progn (setq oldecho (getvar 'cmdecho)) (setvar 'cmdecho 0) (command "_.-linetype" "_l" "Centerx2" "acadiso.lin" "") ;"zwcadiso.lin" "") (setvar 'cmdecho oldecho) ) ) (princ "\n Select Lines to Pairing : ") (if (setq ss (ssget '((0 . "LINE")))) (progn (setq ssl (sslength ss)) (setq index 0) (setq pairingnumber 0) (repeat ssl (setq ent (ssname ss index)) (setq obj (vlax-ename->vla-object ent)) (if (vlax-for each (vlax-get-property obj 'Hyperlinks) (setq checkout (vla-get-url each)) ) (progn) (progn (setq 1len (vlax-get-property obj 'length)) (setq 1deg (vlax-get-property obj 'angle)) (if (>= 1deg (dtr 180)) (setq 1deg (- 1deg (dtr 180)))) (setq 1sp (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'startpoint)) ) ) (setq 1ep (vlax-safearray->list (vlax-variant-value (vlax-get-property obj 'endpoint)) ) ) (setq ss2 (ssget "_X" '((0 . "LINE")))) (setq ss2l (sslength ss2)) (setq index2 0) (setq flag 0) (repeat ss2l (setq ent2 (ssname ss2 index2)) (setq obj2 (vlax-ename->vla-object ent2)) (if (vlax-for each2 (vlax-get-property obj2 'Hyperlinks) (setq checkout2 (vla-get-url each2)) ) (progn) (progn (if (and (/= ent ent2) (= flag 0)) (progn (setq 2len (vlax-get-property obj2 'length)) (setq 2deg (vlax-get-property obj2 'angle)) (if (>= 2deg (dtr 180)) (setq 2deg (- 2deg (dtr 180)))) (if (and (= 1len 2len) (= 1deg 2deg)) (progn (setq 2sp (vlax-safearray->list (vlax-variant-value (vlax-get-property obj2 'startpoint) ) ) ) (setq 2ep (vlax-safearray->list (vlax-variant-value (vlax-get-property obj2 'endpoint) ) ) ) (setq pair11 (distance 1sp 2sp)) (setq pair12 (distance 1ep 2ep)) (setq pair21 (distance 1sp 2ep)) (setq pair22 (distance 1ep 2sp)) ;(princ pair11) (if (and (= (rtos pair11 2 2) (rtos pair12 2 2)) (= (rtos pair21 2 2) (rtos pair22 2 2)) ) (progn (if (vlax-for each3 (vlax-get-property obj 'Hyperlinks) (setq checkout3 (vla-get-url each3)) ) (progn) (progn (vla-add (vlax-get-property obj 'Hyperlinks) (vl-princ-to-string pairingnumber) ) (vla-add (vlax-get-property obj2 'Hyperlinks) (vl-princ-to-string pairingnumber) ) (setq pairingnumber (+ pairingnumber 1)) (setq flag 1) (if (> pair11 pair21) (progn (setq line1 (entmakex (list (cons 0 "LINE") (cons 62 6) (cons 10 1sp) (cons 11 2sp) ) ) ) (setq line2 (entmakex (list (cons 0 "LINE") (cons 62 6) (cons 10 1ep) (cons 11 2ep) ) ) ) (setq midpt (list (/ (+ (car 1sp) (car 2sp)) 2) (/ (+ (cadr 1sp) (cadr 2sp)) 2) 0.0 ) ) ) (progn (setq line1 (entmakex (list (cons 0 "LINE") (cons 62 6) (cons 10 1sp) (cons 11 2ep) ) ) ) (setq line2 (entmakex (list (cons 0 "LINE") (cons 62 6) (cons 10 1ep) (cons 11 2sp) ) ) ) (setq midpt (list (/ (+ (car 1sp) (car 2ep)) 2) (/ (+ (cadr 1sp) (cadr 2ep)) 2) 0.0 ) ) ) ) (setq midlinelen (+ 1len 20)) (setq midpt1 (polar midpt 1deg (/ midlinelen 2))) (setq midpt2 (polar midpt (+ 1deg pi) (/ midlinelen 2) ) ) (setq midline (entmakex (list (cons 0 "LINE") (cons 6 "Centerx2") (cons 62 1) (cons 48 0.2) (cons 10 midpt1) (cons 11 midpt2) ) ) ) ) ) ) (progn ; The length and angle are the same, but the positions are misaligned. ) ) ) (progn) ) ) (progn) ) ) ) (setq index2 (+ index2 1)) ) ) ) (setq index (+ index 1)) ) ) (progn) ) (@DelAllUrl) (vla-endundomark acdoc) (princ) ) Draw a ribbon and a center line on a pair of lines with matching length and angle. The offset of the center line is 10, and centerx2 of acadiso.lin is used. Since the selection is made according to the order of the selection set regardless of the distance, if there are multiple candidates for parallel lines, they may be paired with unwanted ones. You can create one more selection set and measure the distance.
    1 point
  4. I have 1 lisp called autoload.lsp loaded to the Start up suite so loads on opening Autocad/Bricscad it has 10 (load "????") as well as 12 "Autoload" 23 defuns. The Autoload has advantage it loads when you type the command. (autoload "COPY0" '("COPY0")) (autoload "COPYCOMMAND" '("ZZZ")) (autoload "COVER" '("COVER")) So add your samll defuns to that then ready to go, big defuns use (load.
    1 point
  5. @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
×
×
  • Create New...