Jump to content

Leaderboard

Popular Content

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

  1. Need a dwg to test on but hopefully this makes sense. (progn (repeat (setq x (sslength blk)) (setq blkitem (ssname blk (setq x (1- x)))) (setq Tag (nth 0 Final_Destination)) (setq Val (nth 0 Final_Value)) (lm:setattributevalue blkitem Tag Val) (setq Tag (nth 1 Final_Destination)) (setq Val (nth 1 Final_Value)) (lm:setattributevalue blkitem Tag Val) ) ) Just a PS I would make the Blkitem a vl object and just update the attribute via its order in the attributes. Like say 3 & 5.
    1 point
  2. My $0.05 :Move Select entities to move: Opposite Corner: Entities in set: 47 Select entities to move: Enter Enter base point [Displacement] <Displacement>:(getvar 'extmin) (-245.13133939846 -595.107261489551 0.0) Enter base point [Displacement] <Displacement>: Enter second point <Use base point as displacement>:0,0
    1 point
  3. So, if you look at the AutoCAD command copyclip and pasteclip, this will paste the copied entities and and for the insertion point this will be the most left entity and the bottom entity (bottom left corner) without the need to calculate the drawing limits. This should make it easier.. Try this, the command is 'Move 0-0' (or M00 ) (defun c:M00 ( / MySS) (command "undo" "end") ; clear undo marker, Simplest undo function used (command "undo" "begin") ; set undo marker (setq MySS (ssget "_X")) ; Select everything (command "copyclip" MySS "") ; copy everything to the clip board. By default insert point is lower left corner (command "pasteclip" '(0 0 0)) ; paste everything as a copy (command "erase" MySS "") ; delete original entities... after pasting just in case paste goes all wrong (command "undo" "end") ; clear undo marker ); end defun If I haven't understood this quite right post your code as you have it with a couple of notes what you are doing and will see if we can modify that
    1 point
  4. Try this, change the lists in 'values' as required, the loop later on works by the Final_values list, if Final_Destination list is shorter than that there could be problems. You could check for that in the code though (defun c:test ( / Tag Val Blk acount) ;;Values (setq Final_Block "MyBlock") ; Block Name (setq Final_Value (list "Value 1" "Value 2")) ; can increase this as required (setq Final_Destination (list "Tag1" "Tag2")) ; can increase this as required ;; Sub Functions (defun LM:setattributevalues ( blk lst / enx itm ) (while (and (setq blk (entnext blk)) (= "ATTRIB" (cdr (assoc 0 (setq enx (entget blk)))))) (if (and (setq itm (assoc (cdr (assoc 2 enx)) lst)) (entmod (subst (cons 1 (cdr itm)) (assoc 1 (reverse enx)) enx)) ) (entupd blk) ) ) nil ) (if (= (setq blk (ssget "_X" (list (cons 2 Final_Block)))) nil) (progn (princ "Block Not Found") ) (progn (setq blk (ssname blk 0)) (setq acount 0) (while (< acount (length Val)) (setq Tag (nth 1 Final_Destination)) (setq Val (nth 1 Final_Value)) (lm:setattributevalue blk Tag Val) (setq acount (+ acount 1)) ) ) ) )
    1 point
  5. 1 remove last line (c:test) 2 rtos ... 2 0 3 vla-SetTextHeight ..... 2.5 change this & rowheight 7. mm settings
    1 point
  6. Here is a table version, works for me as metric may need mods for inches re row sizes etc. Will only work in modelspace see curspace. Tharwat stuffed up lambda please help any other suggestions welcome. (defun c:Test (/ s x y doc objtable numrows rowheight pt1 colwidth curspace) ;; Tharwat 26. 08. 2015 ; ;; mods by BIGAL 29.08.2015 now as table (vl-load-com) (setq doc (vla-get-activedocument (vlax-get-acad-object))) (setq curspace (vla-get-modelspace doc)) (setq pt1 (vlax-3d-point (getpoint "\nPick point for top left hand of table: "))) (princ "\nSelect LWpolylines to export to a Table :") (setq s (ssget '((0 . "LWPOLYLINE")))) (if (/= s nil) (progn ; now do table (setq numrows (+ 2 (sslength s))) (setq numcolumns 2) (setq rowheight 7) (setq colwidth 25) (setq objtable (vla-addtable curspace pt1 numrows numcolumns rowheight colwidth)) (vla-settext objtable 0 0 "Pline lengths") (vla-setcolumnwidth objtable 0 10) (vla-setcolumnwidth objtable 1 25) (vla-settext objtable 1 0 "Pline") (vla-settext objtable 1 1 "Length") (vla-SetTextHeight Objtable (+ acDataRow acHeaderRow acTitleRow) 2.5) (vla-SetAlignment Objtable acDataRow acMiddleCenter) (setq x 1) (SETQ Y 2) (setq r -1) ;((lambda (r / e) (while (setq e (vlax-ename->vla-object(ssname s (setq r (1+ r))))) (vla-settext objtable Y 0 (rtos x 2 0)) (vla-settext objtable Y 1 (rtos (cvunit (vla-get-length e) "inch" "feet") 2 4)) (setq x (1+ x )) (setq y (1+ Y )) ); while ; )) ;lambda ) ;progn (alert "You have not picked any plines run again") ) ; if (princ) ) ; defun (c:test)
    1 point
×
×
  • Create New...