Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 10/09/2024 in all areas

  1. This one works on my system: (command "shell" "chrome https://www.nhm.ac.uk/discover/dino-directory/name/name-az-all.html") The "explorer" opens the windows explorer.
    2 points
  2. "last saved space" What about (getvar 'ctab). Do they really have that many title blocks that you can not make a list to match ? I have code that looks for say 8 different title blocks and plots them.
    1 point
  3. This is a testing version only but it seems to work. I wonder what CAD wizard made this mess of a detail library (vl-load-com) ;; ;; Fix the extrusuion values of hatches so they are 0,0,1 ;; ;; TESTING VERSION ;; ;; Thread here: https://www.cadtutor.net/forum/topic/92094-flatten-issue-with-drawing ;; ;; 3dwannab 2024.10.08 ;; ;; TO DO: ;; - Make this work for ENTITIES inside BLOCKS ;; (defun c:FXHatchExtrusion_To_0 (/ *error* acDoc cnt dxf210 ent entData newEntData newExtrude newExtrudeVal obj oldExtrude ss typ var_cmdecho) (defun *error* (errmsg) (and acDoc (vla-EndUndoMark acDoc)) (and errmsg (not (wcmatch (strcase errmsg) "*CANCEL*,*EXIT*")) (princ (strcat "\n<< Error: " errmsg " >>\n")) ) (setvar 'cmdecho var_cmdecho) ) ;; Start the undo mark here (setq acDoc (vla-get-ActiveDocument (vlax-get-acad-object))) (or (vla-EndUndoMark acDoc) (vla-StartUndoMark acDoc)) ;; Get any system variables here (setq var_cmdecho (getvar "cmdecho")) (setvar 'cmdecho 0) (if (setq ss (ssget "_:L" '((0 . "HATCH")))) (progn (repeat (setq cnt (sslength ss)) (setq cnt (1- cnt)) (setq ent (_dxf -1 (entget (ssname ss cnt)))) (setq entData (entget ent)) ; Get the entity's data list (setq obj (vlax-ename->vla-object ent)) (setq typ (cdr (assoc 0 (entget ent)))) (cond ;; Placeholder condition for other entities ; ((= typ "**") ; ) ;; end cond ;; Condition for HATCHES. ((= typ "HATCH") (setq newExtrudeVal 0.0) ; Set this to 0.0 (if (setq dxf210 (assoc 210 entData)) (progn (setq oldExtrude (cdr dxf210)) ;; Extract the current extrude components (setq newExtrude (list (nth 0 oldExtrude) newExtrudeVal (nth 2 oldExtrude))) ;; Create the new extrude with the modified Y component (setq newEntData (subst (cons 210 newExtrude) dxf210 entData)) ;; Replace the old extrude with the new extrude (entmod newEntData) ;; Apply the changes to the HATCH entity (entupd ent) ; Update the entity to reflect the change ) ) ) ;; end cond HATCH ) ) ) ;; progn ) ;; if ssget (if ss (progn (princ (strcat ">> " (itoa (sslength ss)) (if (> (sslength ss) 1) " objects extrude values are" " objects extrude value is") " fixed <<\n")) (sssetfirst nil ss) (command "_.regen") ) ) (vla-EndUndoMark acDoc) (*error* nil) (princ) ) ;; ----------------------------------------------------------------------- ;; ----------------------=={ Functions START }==-------------------------- ;;----------------------------------------------------------------------;; ;; _dxf ;; Finds the association pair, strips 1st element ;; args - dxfcode elist ;; Example - (_dxf -1 (entget (ssname (ssget) 0))) ;; Returns - <Entity name: xxxxxxxxxxx> (defun _dxf (code elist) (cdr (assoc code elist)) ) (c:FXHatchExtrusion_To_0) ;; Unlbock for testing
    1 point
  4. Command DLBL (for Draw Line from Blocks to Line) (defun drawLine (p1 p2) (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))) ;; DLBL for Draw Line from Blocks to Line (defun c:DLBL ( / ln blks i p1 p2) (setq ln (car (entsel "\nSelect line: " ))) (princ "\nSelect blocks: ") (setq blks (ssget (list (cons 0 "INSERT")))) (setq i 0) (repeat (sslength blks) ;; p1: insertpoint of the block (setq p1 (cdr (assoc 10 (entget (ssname blks i))))) ;; p2: closest point, perpendicular to the line. (setq p2 (vlax-curve-getClosestPointTo ln p1)) (drawLine p1 p2) (setq i (+ i 1)) ) )
    1 point
×
×
  • Create New...