Jump to content

Leaderboard

Popular Content

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

  1. Yes you can get at the properties of an image ie Lat & Long, in this case I used an external program to get the image properties making a script, inside CIV3D lat long import is supported, so inserted multiple images in one go, the images came from a mobile phone. Trying to remember the name of the program. There was a post some where recently about getting file details.
    1 point
  2. Are all the marker texts on their own layer, so you could isolate them from other texts (turn off everything else with text in leaving just the text you want?) This is one I use and can be modified - however it is taken from a larger LISP file, something might be missing so let me know if it doesn't work. It asks "select text" - here select the distances, 1 mile, 1.01 mile, whatever, this has to be just a number in the drawing "1.11" and not say "1.11m". Then select profile is the polyline route on which to put the markers, and finally start end (0 distance) - start end has to be the end of the polyline, can't be part way along it. The chainage marker is a block made in the routine and can be amended. I think if you just want evenly spaced markers the link at the top of the code does that (1, 2, 3 miles etc) - again with a marker block that can be modified. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;https://www.cadtutor.net/forum/topic/1264-drawing-points-along-polyline/ (defun C:LSChainage ( / MyPt ppt pent ang cumm_dist dis dist_list leng obj pt reversed) ;; Set Attribute Value - Lee Mac ;; Sets the value of the first attribute with the given tag found within the block, if present. ;; blk - [ent] Block (Insert) Entity Name ;; tag - [str] Attribute TagString ;; val - [str] Attribute Value ;; Returns: [str] Attribute value if successful, else nil. (defun LM:setattributevalue ( blk tag val / enx ) (if (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))) (if (= (strcase tag) (strcase (cdr (assoc 2 enx)))) (if (entmod (subst (cons 1 val) (assoc 1 (reverse enx)) enx)) (progn (entupd blk) val ) ; end progn ) ; end if (LM:setattributevalue blk tag val) ) ; end if ) ; end if ) ; end defun ;;Chainage, make a small mark every 1/2 distance and add distance and big mark every distance (defun make_blk_measure ( / ) (if (not (tblsearch "STYLE" "$BLK_MEAS")) (entmake '((0 . "STYLE") (5 . "40") (100 . "AcDbSymbolTableRecord") (100 . "AcDbTextStyleTableRecord") (2 . "$BLK_MEAS") (70 . 0) (40 . 0.0) (41 . 0.7) (50 . 0.0) (71 . 0) (42 . 0.1) (3 . "ARIAL.TTF") (4 . "") ) ; end '( list ) ; end entmake ) ; end if (if (not (tblsearch "BLOCK" "BLK_MEASURE_CURVE")) (progn (entmake '((0 . "BLOCK") (8 . "0") (2 . "BLK_MEASURE_CURVE") (70 . 2) (4 . "") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (10 0.0 0.0 0.0)) ) ; end entmake (entmake (append '((0 . "LINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbLine")) (list (list 10 0.0 (- (getvar "TEXTSIZE")) 0.0)) (list (list 11 0.0 (getvar "TEXTSIZE") 0.0)) '((210 0.0 0.0 1.0)) ) ; end eppend ) ; end entmake (entmake '( (0 . "ATTDEF") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbText") (10 0.0 0.0 0.0) (40 . 2.5) ; font height (1 . "0.0") (50 . 1.570796326794896) (41 . 0.7) (51 . 0.0) ;; (7 . "$BLK_MEAS") (71 . 8) (72 . 1) (11 1.0 0.0 0.0) (210 0.0 0.0 1.0) (100 . "AcDbAttributeDefinition") (3 . "measure") (2 . "VALUE_MEASURE") (70 . 0) (73 . 0) (74 . 1) ) ; end '( list ) ; end entmake (entmake '((0 . "ENDBLK") (8 . "0") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2))) ) ; end prgn ) ; end if (if (not (tblsearch "BLOCK" "BLK_TICK_CURVE")) (progn (entmake '((0 . "BLOCK") (8 . "0") (2 . "BLK_TICK_CURVE") (70 . 2) (4 . "") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (10 0.0 0.0 0.0)) ) ; end entmake (entmake (append '((0 . "LINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbLine")) (list (list 10 0.0 (* 0.5 (- (getvar "TEXTSIZE"))) 0.0)) (list (list 11 0.0 (* 0.5 (getvar "TEXTSIZE")) 0.0)) '((210 0.0 0.0 1.0)) ) ; end append ) ; end entmake (entmake '((0 . "ENDBLK") (8 . "0") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2))) ) ; end progn ) ; end if ) ; end defun 'make_blk_measure' ;;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/end-selection-in-loop-with-enter-button/td-p/8815294 (defun LSGrabTexts ( / distlist ent) (setq distlist nil) (setvar 'errno 0) (while ; loop selecting texts (progn (setvar 'errno 0) (setq ent (car (entsel "\nSelect Text: "))) (cond ( (= 7 (getvar 'errno)) ;cond a (princ "\nMissed, try again.") ) ;end cond a ( (= 'ename (type ent)) ;cond b (princ (setq dist (cdr (assoc 1 (entget ent)))) ) (setq distlist (append distlist (list (atof dist)))) ) ;end cond b ) ; end progn ) ; end while ) ; end defun (princ "\nDistances: ")(princ distlist) distlist ) ;;End sub functions;; (setq dist_list (LSGrabTexts)) ; get absolute distances (setq dist_list_orig dist_list) (setq cumm_dist (apply 'max dist_list)) (setq dis 0.0) (setq pent (car (entsel "\n >> Select profile >>"))) (setq ppta (assoc 10 (entget pent))) ; start of route line (setq pptb (assoc 10 (reverse (entget pent)) )) ; end of route line (setq MyPt (getpoint "\nSelect Start Point")) (setq obj (vlax-ename->vla-object pent)) (setq leng (vlax-curve-getdistatpoint obj (vlax-curve-getendpoint obj))) (if (or ;; Selected MyPt at ends of route line (= (vlax-curve-getdistatpoint obj MyPt) 0) (= (vlax-curve-getdistatpoint obj MyPt) leng) ) (progn ) ; end progn (progn (setq MyEndPt (getpoint "\nSelect a Point in the Direction")) (setq lenga (vlax-curve-getdistatpoint obj MyPt)) (setq lengb (vlax-curve-getdistatpoint obj MyEndPt)) (if (< lenga lengb) (progn (princ "\nA-B Calc Start Point") (setq newlist (list)) (setq acount 0) (while (< acount (length dist_list)) (setq newval (+ lenga (nth acount dist_list))) (if (< newval 0)(setq newval 0)) (setq newlist (append newlist (list newval))) (setq acount (+ acount 1)) ) (setq dist_list newlist) (setq MyPt (list (cadr ppta) (caddr ppta) 0) ) ) ; end progn (progn (princ "\nB-A Calc Start Point") (setq newlist (list)) (setq acount 0) (while (< acount (length dist_list)) (setq newval (+ (- leng lenga) (nth acount dist_list))) (if (< newval 0)(setq newval 0)) (setq newlist (append newlist (list newval))) (setq acount (+ acount 1)) ) (setq dist_list newlist) (setq MyPt (list (cadr pptb) (caddr pptb) 0) ) ) ; end progn ) ; end if ) ; end progn ) ; end if (if (= (vlax-curve-getdistatpoint obj MyPt) 0) () (progn (princ "\nReverse") (setq newlist (list)) (setq acount 0) (while (< acount (length dist_list)) (setq newval (- leng (nth acount dist_list))) (if (< newval 0)(setq newval 0)) (setq newlist (append newlist (list newval))) (setq acount (+ acount 1)) ) (princ newlist) (setq dist_list newlist) ) ) ; end if (setq acount 0) (while (< acount (length dist_list)) (setq dis (nth acount dist_list)) (if (> (nth acount dist_list) leng)(setq dis leng)) ;; fudge if SOP greater than route length?? (setq pt (vlax-curve-getpointatdist obj dis)) ;;insert block 'tick' (make_blk_measure) (setq ang (angle '(0 0 0) (vlax-curve-getfirstderiv obj (vlax-curve-getparamatpoint obj pt)))) (vlax-invoke (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) 'InsertBlock pt "BLK_MEASURE_CURVE" 1 1 1 ang) (setq MyLastBlock (entlast)) (LM:setattributevalue MyLastBlock "VALUE_MEASURE" (strcat (rtos (nth acount dist_list_orig))) ) ;;or draw point: ;; (vlax-invoke (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))) 'AddPoint pt) (setq dist_list (cdr dist_list)) (setq acount (+ acount 1)) ) ;end while (princ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    1 point
  3. (defun c:SYSINFO ( / getiplist iplist ipv6list driveindex drivetxt noofdrive drivesr) ;https://www.theswamp.org/index.php?topic=42276.0 (defun getip ( / WMI CSERV EXQ gip) (vl-load-com) (setq WMI (vlax-create-object "WbemScripting.SWbemLocator")) (setq CSERV (VLAX-INVOKE WMI 'ConnectServer "." "\\root\\cimv2" nil nil nil nil nil nil)) (setq EXQ (vlax-invoke CSERV 'ExecQuery "Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = true")) (vlax-for item EXQ (setq gip (vlax-get item 'IPAddress)) ) (vlax-release-object wmi) (vlax-release-object CSERV) (vlax-release-object EXQ) gip ) ;https://www.cadtutor.net/forum/topic/9848-how-to-get-serial-number-of-hard-drive-by-lisp/?do=findComment&comment=540967 (defun Get_BaseBoardSerialNumber (/ LocatorObj ServiceObj ObjectSetObj SerialNumber) (setq LocatorObj (vlax-create-object "WbemScripting.SWbemLocator") ) (setq ServiceObj (vlax-invoke LocatorObj 'ConnectServer nil nil nil nil nil nil nil nil) ) (setq ObjectSetObj (vlax-invoke ServiceObj 'ExecQuery "Select * from Win32_BaseBoard" ) ) (vlax-for Obj ObjectSetObj (setq SerialNumber (vlax-get Obj 'SerialNumber) ) ) (foreach Obj (list LocatorObj ServiceObj ObjectSetObj) (and Obj (vlax-release-object Obj)) ) SerialNumber ) ;https://www.cadtutor.net/forum/topic/9848-how-to-get-serial-number-of-hard-drive-by-lisp/?do=findComment&comment=540992 (defun Get_ProcessorId (/ LocatorObj SecurityObj SecurityObj ObjectSetObj Processor_Id ) (setq LocatorObj (vlax-create-object "WbemScripting.SWbemLocator") ) (setq ServiceObj (vlax-invoke LocatorObj 'ConnectServer nil nil nil nil nil nil nil nil) ) (setq ObjectSetObj (vlax-invoke ServiceObj 'ExecQuery "Select * from Win32_Processor" ) ) (vlax-for Obj ObjectSetObj (setq Processor_Id (vlax-get Obj 'ProcessorId) ) ) (foreach Obj (list LocatorObj ServiceObj SecurityObj ObjectSetObj) (and Obj (vlax-release-object Obj)) ) Processor_Id ) ;https://www.cadtutor.net/forum/topic/9848-how-to-get-serial-number-of-hard-drive-by-lisp/?do=findComment&comment=540993 (defun Get_UUID (/ LocatorObj ServiceObj ObjectSetObj UUID) (setq LocatorObj (vlax-create-object "WbemScripting.SWbemLocator") ) (setq ServiceObj (vlax-invoke LocatorObj 'ConnectServer nil nil nil nil nil nil nil nil) ) (setq ObjectSetObj (vlax-invoke ServiceObj 'ExecQuery "SELECT UUID FROM Win32_ComputerSystemProduct" ) ) (vlax-for Obj ObjectSetObj (setq UUID (vlax-get Obj 'UUID) ) ) (foreach Obj (list LocatorObj ServiceObj ObjectSetObj) (and Obj (vlax-release-object Obj)) ) UUID ) ;https://www.cadtutor.net/forum/topic/9848-how-to-get-serial-number-of-hard-drive-by-lisp/?do=findComment&comment=540994 (defun SerialInfo_BIOS (/ WMI meth1 meth2 serial) (vl-load-com) (cond ((and (setq WMI (vlax-create-object "WbemScripting.SWbemLocator")) (setq meth1 (vlax-invoke WMI 'ConnectServer nil nil nil nil nil nil nil nil)) (setq meth2 (vlax-invoke meth1 'ExecQuery (strcat "Select * from Win32_" "BIOS"))) (vlax-for itm (vlax-get (vlax-invoke meth2 'ItemIndex 0) 'Properties_) (if (eq (vlax-get itm 'name) "SerialNumber") (setq serial (vlax-get itm 'value))))))) (mapcar 'vlax-release-object (list meth1 meth2 wmi)) serial) ;https://www.cadtutor.net/forum/topic/9848-how-to-get-serial-number-of-hard-drive-by-lisp/?do=findComment&comment=540995 (defun get_macaddress (/ Locator Server Query ret) (if (and (setq Locator (vlax-create-object "WbemScripting.SWbemLocator")) (setq Server (vlax-invoke Locator 'ConnectServer "." "root\\cimv2")) (setq Query (vlax-invoke Server 'ExecQuery "select * from Win32_NetworkAdapterConfiguration where IPEnabled = True"))) (vlax-for item Query (setq ret (vlax-get item 'MacAddress)))) (foreach obj (list Locator Server Query) (vl-catch-all-apply 'vlax-release-object (list obj))) ret) ;https://www.cadtutor.net/forum/topic/9848-how-to-get-serial-number-of-hard-drive-by-lisp/?do=findComment&comment=79829 ;;; * ;;; PART OF 'ASMILIB' LIBRUARY * ;;; Created: 07.10.2007 * ;;; Last modyfied: 07.10.2007 * ;;; ⓒ Alexanders Smirnovs (ASMI) * ;;; * ;;; ********************************* ;;; **** PC Hardware Functions ****** ;;; ********************************* ;;; * ;;; Retrieves Hard Drive serial number * ;;; * ;;; Arguments: * ;;; Path - Path of Hard Drive, for example "C:" (string) * ;;; * ;;; Output: * ;;; Hard Drive serial number (integer) or NIL in case of error. * ;;; * (defun #Asmi_Get_Drive_Serial (Path / fsObj hSn abPth cDrv) (vl-load-com) (if (and (setq fsObj(vlax-create-object "Scripting.FileSystemObject")) (not (vl-catch-all-error-p (setq abPth(vl-catch-all-apply 'vlax-invoke-method (list fsObj 'GetAbsolutePathName Path)) ); end setq ); end vl-catch-all-error-p ); end not ); end and (progn (setq cDrv(vlax-invoke-method fsObj 'GetDrive (vlax-invoke-method fsObj 'GetDriveName abPth ); end vlax-invoke-method );end vlax-invoke-method ); end setq (if (vl-catch-all-error-p (setq hSn(vl-catch-all-apply 'vlax-get-property (list cDrv 'SerialNumber)))) (progn (vlax-release-object cDrv) (setq hSn nil) ); end progn ); end if (vlax-release-object fsObj) ); end progn ); end if hSn ); end of #Asmi_Get_Drive_Serial ;https://www.theswamp.org/index.php?topic=44425.0 (defun _ping (address / out ws) (if (setq ws (vlax-get-or-create-object "WScript.Shell")) (progn (setq out (vlax-invoke ws 'run (strcat "ping.exe -n 1 " address) 0 :vlax-true)) (and ws (vlax-release-object ws)) (zerop out) ) ) ) (if (_ping "google.com") (setq internetping "Yes") (setq internetping "No")) (setq getiplist (getip)) (setq iplist (LM:str->lst (vl-princ-to-string (car getiplist)) " ")) (setq ipv6list (LM:str->lst (vl-princ-to-string (cadr getiplist)) " ")) ;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/hard-drive-number-in-lisp/m-p/902962/highlight/true#M128620 (defun vl-finddrive (/ DriveList) (foreach Item '("Z" "X" "Y" "V" "W" "U" "T" "S" "R" "Q" "P" "O" "N" "M" "L" "K" "J" "I" "H" "G" "F" "E" "D" "C" "B" "A") (if (= (vl-file-size (strcat Item ":/")) 0.0) (setq DriveList (cons (strcat Item ":/") DriveList)) );end if );end foreach DriveList );end vl-finddrive ;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/decimal-to-hexadecimal/m-p/2874070/highlight/true#M293991 (defun STD-NUM->HEX (i / s a) (setq s "") (while (> i 0) (setq a (rem i 16) i (lsh i -4) ) ;_ setq (setq s (strcat (if (< a 10) (chr (+ 48 a)) ; 48: (ascii "0") (chr (+ 55 a)) ) ;_ if s ) ;_ strcat ) ;_ setq ) ;_ while ) ;_ defun ;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/list-to-string/m-p/830687/highlight/true#M56345 (defun strlcat (delim lst) (apply 'strcat (cons (substr (car lst) 1 1) (mapcar '(lambda (x) (strcat delim (substr x 1 1)) ) (cdr lst) ) ) ) ) (setq noofdrive (length (vl-finddrive))) (setq drivetxt "") (setq driveindex 0) (repeat noofdrive (setq drivesr (strcat (substr (setq sn (dos_serialno (nth driveindex (vl-finddrive)) )) 1 4) "-" (substr (setq sn (dos_serialno (nth driveindex (vl-finddrive)) )) 5 4))) (setq drivetxt (strcat drivetxt "\n " (substr (nth driveindex (vl-finddrive)) 1 1) " Drive Serial = " (vl-princ-to-string drivesr) )) (setq driveindex (+ driveindex 1)) ) ;(princ drivetxt) (setq infomsg (strcat " Internet Connection = " (vl-princ-to-string internetping) "\n IP = " (vl-princ-to-string (caddr iplist)) "\n IPv6 = " (vl-princ-to-string (caddr ipv6list)) "\n Log-on Server = " (vl-princ-to-string (getenv "LOGONSERVER")) "\n Computer Name = " (vl-princ-to-string (getenv "COMPUTERNAME")) "\n User Name = " (vl-princ-to-string (getenv "USERNAME")) "\n MainBoard Serial = " (vl-princ-to-string (get_baseboardSerialNumber)) "\n Processor ID = " (vl-princ-to-string (Get_ProcessorId)) "\n UUID = " (vl-princ-to-string (Get_UUID)) "\n BIOS Serial = " (vl-princ-to-string (SerialInfo_BIOS)) "\n MAC Address = " (vl-princ-to-string (get_macaddress)) "\n Connected Drive = " (vl-princ-to-string (strlcat ", " (vl-finddrive))) drivetxt ) ) (princ infomsg) ;; 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) ) ) ) (LM:popup "PC System Info" infomsg (+ 0 64 4096)) (princ) ) I've put together some nice code written by dilan, for beginners like me. Others have also been collected and links have been attached. command is SYSINFO - Drive serial is not manufacturer's unique serial number. this can be change with just formatting
    1 point
×
×
  • Create New...