Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 08/16/2023 in all areas

  1. I use @Lee Mac Areas2Attribute http://www.lee-mac.com/areafieldtoattribute.html
    2 points
  2. Look at a Toggle button for Hatch on or off.
    1 point
  3. Just write new code it would be a few lines long, text1-text2 and use 1st text property in a entmake text. Good task to start learning.
    1 point
  4. @devitg FWIW the code could be simplified like so using (REM ANGLE PI) (defun c:vhlines-rjp (/ *error* ang e i s sn ss) ;;; Tharwat 13. Dec. 2012 ;;; ;; RJP » 2023-08-15 (if (and (progn (initget "Vertical Horizontal Both") (setq kw (cond ((getkword "\n Specify one [Vertical/Horizontal/Both] <Both> :")) ("Both") ) ) ) (setq s (ssadd)) (setq ss (ssget "_X" (list '(0 . "LINE") (cons 410 (getvar 'ctab))))) ) (progn ;; RJP - moved check out of loop (setq kw (cadr (assoc kw '(("Vertical" (equal ang (* pi 0.5) 1e-8)) ("Horizontal" (equal ang 0. 1e-8)) ("Both" (or (equal ang (* pi 0.5) 1e-8) (equal ang 0. 1e-8))) ) ) ) ) (repeat (setq i (sslength ss)) (setq sn (ssname ss (setq i (1- i))) e (entget sn) ) ;; RJP mod to return 0 or (* pi 1.5) (setq ang (rem (angle (cdr (assoc 10 e)) (cdr (assoc 11 e))) pi)) (and (eval kw) (ssadd sn s)) ) (sssetfirst nil s) ) ) (princ) ) (defun c:vhlines-rjp2 (/ *error* ang e i s sn ss) ;;; Tharwat 13. Dec. 2012 ;;; ;; RJP » 2023-08-15 ;; Returns all lines NOT vertical or horizontal (if (and (setq s (ssadd)) (setq ss (ssget "_X" (list '(0 . "LINE") (cons 410 (getvar 'ctab)))))) (progn (repeat (setq i (sslength ss)) (setq sn (ssname ss (setq i (1- i))) e (entget sn) ) (setq ang (rem (angle (cdr (assoc 10 e)) (cdr (assoc 11 e))) pi)) (or (or (equal ang (* pi 0.5) 1e-8) (equal ang 0. 1e-8)) (ssadd sn s)) ) (sssetfirst nil s) ) ) (princ) )
    1 point
  5. You're most welcome, I'm glad it helps. Those are DXF group code (I simply pad them to 3 digits to please my OCD) - here is a DXF reference. Navigate to ENTITIES and then review Common Group Codes and those for TEXT entity. We can change the acquisition of the points from an if to a while - consider the following: (defun c:bd ( / ang ber dis mid pt1 pt2 scl ) (initget 6) (if (setq scl (getreal "\nSpecify drawing scale: ")) (while (and (setq pt1 (getpoint "\nSpecify 1st point <exit>: ")) (setq pt2 (getpoint "\nSpecify 2nd point <exit>: " pt1)) ) (setq ang (angle pt1 pt2) dis (* scl 0.001 (distance pt1 pt2)) mid (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) pt1 pt2) ) (entmake (list '(000 . "TEXT") '(008 . "DIM") '(062 . 256) '(006 . "BYLAYER") '(040 . 2.0) '(072 . 1) '(073 . 2) (cons 007 (if (tblsearch "style" "SS") "SS" (getvar 'textstyle))) (cons 010 (polar mid (+ ang (/ pi 2.0)) 5.0)) (cons 011 (polar mid (+ ang (/ pi 2.0)) 5.0)) (cons 050 ang) (cons 001 (vl-string-translate "." "|" (rtos dis 2 3))) ) ) (setq ber (angtos ang) ber (vl-string-subst "%%d" "d" ber) ber (vl-string-subst "%%135" "'" ber) ber (vl-string-subst "%%136" "\"" ber) ) (entmake (list '(000 . "TEXT") '(008 . "BEAR") '(062 . 256) '(006 . "BYLAYER") '(040 . 2.0) '(072 . 1) '(073 . 2) (cons 007 (if (tblsearch "style" "SU") "SU" (getvar 'textstyle))) (cons 010 (polar mid (+ ang (/ pi 2.0)) 2.5)) (cons 011 (polar mid (+ ang (/ pi 2.0)) 2.5)) (cons 050 ang) (cons 001 ber) ) ) ) ) (princ) )
    1 point
  6. You can get hard disk Id, Mac address, or processor ID as suggested. Some hard disk code examples (setq ser (vla-get-Serialnumber (vlax-invoke (vlax-create-object "Scripting.FileSystemObject") 'getdrive "c:"))) ; drive type 1 is a usb 2 hard disk (defun UsbDriveSerialNumber ( / fso dr) (setq fso (vlax-create-object "Scripting.FileSystemObject")) (vlax-for d (vlax-get fso 'Drives) (if (= (Vlax-get d 'DriveType) 2) (setq dr (cons (list (vla-get-path d) (vla-get-SerialNumber d)) dr) ) ) ) (vlax-release-object fso) (reverse dr) ) (UsbDriveSerialNumber) (vlax-for d (vlax-get fso 'Drives) (princ (Vlax-get d 'DriveType) ) ) "Can i ask how it work?" Did you look at the lisp posted ?
    1 point
×
×
  • Create New...