Jump to content

All Activity

This stream auto-updates

  1. Past hour
  2. This worked for me ;;;---------------------------------------------------------------------------; ;;; ;;; vpsel.lsp ;;; ;;; By Jimmy Bergmark ;;; Copyright (C) 1997-2006 JTB World, All Rights Reserved ;;; Website: www.jtbworld.com ;;; E-mail: info@jtbworld.com ;;; ;;; 2000-04-14 - First release ;;; Tested on AutoCAD 2000 ;;; ;;;---------------------------------------------------------------------------; ;;; DESCRIPTION ;;; ;;; Select all visible objects in selected or active paperspace viewport ;;; Works transparently when in modelspace and for polygonal viewports too ;;; Example1: ERASE ALL R 'VPC >>> Erase all in model except what is visible ;;; Example2: (command "erase" "all" "r" (c:vpc) "") ;;; Example3: VPC ERASE >>> VPC is run previous the command and the objects ;;; are also in previous selection set ;;; ;;; c:vpc - select all visible objects with crossing in viewport ;;; c:vpw - select all visible objects with window in viewport ;;;---------------------------------------------------------------------------; (defun c:vpttt () (vpselttt "C") (princ) ) (defun c:vpwttt () (vpselttt "W") (princ) ) (defun dxf (n ed) (cdr (assoc n ed))) (defun vpselttt (typ / ad ss ent vpno ok vpbl vpur msbl msur msul mslr ss1 pl nlist x n ) (vl-load-com) (setq ok t) (if (= (getvar "tilemode") 0) (progn (setq ad (vla-get-activedocument (vlax-get-acad-object))) (if (= (getvar "cvport") 1) (if (and (= (getvar "cmdactive") 0) (setq ss (ssget "_x" (list '(0 . "VIEWPORT")))) ) (progn (setq ent (ssname ss 2)) (setq vpno (dxf 69 (entget ent))) (vla-Display (vla-get-activepviewport ad) :vlax-true) (vla-put-mspace ad :vlax-true) (setvar "cvport" vpno) ) (progn (setq ok nil) ) ) (setq ent (vlax-vla-object->ename (vla-get-activepviewport ad))) ) (if (and ok (/= 1 (logand 1 (dxf 90 (setq ed (entget ent)))))) (progn (if (= (vla-get-clipped (vlax-ename->vla-object ent)) :vlax-false ) (progn (vla-getboundingbox (vla-get-activepviewport ad) 'vpbl 'vpur ) (setq msbl (trans (vlax-safearray->list vpbl) 3 2)) (setq msur (trans (vlax-safearray->list vpur) 3 2)) (setq msul (list (car msbl) (cadr msur))) (setq mslr (list (car msur) (cadr msbl))) (setq ss1 (ssget (strcat typ "P") (list msbl msul msur mslr)) ) ) ;;; (progn ;;; (setq pl (entget (dxf 340 (entget ent)))) ;;; (setq nlist nil) ;;; (foreach x pl ;;; (if (eq 10 (car x)) ;;; (setq nlist (cons (trans (cdr x) 3 2) nlist)) ;;; ) ;;; ) ;;; (setq ss1 (ssget (strcat typ "P") nlist)) ;;; ) ) (sssetfirst nil ss1) (if ss1 (setq n (sslength ss1)) (setq n 0) ) (princ n) (princ " found ") (if (and ss1 (= (getvar "cmdactive") 1)) ss1 ) ) ) ) ) ;;; (setq ss nil ss1 nil) (setq data ss1) (setq i 0) (repeat (sslength data) (setq e (ssname data i)) (if (and (< i (sslength data)) (equal "DIMENSION" (cdr (assoc 0 (entget e)))) ) (progn (setq entdimnstyle (entget e)) (setq newdim (subst (cons 3 "NewDimension") (assoc 3 entdimnstyle) entdimnstyle ) ) (entmod newdim) (setq i (1+ i)) ) (setq i (1+ i)) ) ) ) (princ)
  3. Today
  4. Hello, If I run each line of this section of code it works , but if I incorporate it in modified VPSEL lisp, it gets stacked somewhere. Lisp doesn't stop on error, neither on break toggle. I wonder if I need (else parameter in (if .and if I need else parameter indeed I don't know how tell the lisp continue to next item. (setq data ss1) (setq i 0) (repeat (sslength data) (setq e (ssname data i)) (if (and (< i (sslength data)) (equal "DIMENSION" (cdr (assoc 0 (entget e)))) ) (setq entdimnstyle (entget e)) (setq newdim (subst (cons 3 "NewDimension") (assoc 3 entdimnstyle) entdimnstyle ) (entmod newdim) ) (setq i (1+ i)) ) ) ) and here is the complete code ;;;---------------------------------------------------------------------------; ;;; ;;; vpsel.lsp ;;; ;;; By Jimmy Bergmark ;;; Copyright (C) 1997-2006 JTB World, All Rights Reserved ;;; Website: www.jtbworld.com ;;; E-mail: info@jtbworld.com ;;; ;;; 2000-04-14 - First release ;;; Tested on AutoCAD 2000 ;;; ;;;---------------------------------------------------------------------------; ;;; DESCRIPTION ;;; ;;; Select all visible objects in selected or active paperspace viewport ;;; Works transparently when in modelspace and for polygonal viewports too ;;; Example1: ERASE ALL R 'VPC >>> Erase all in model except what is visible ;;; Example2: (command "erase" "all" "r" (c:vpc) "") ;;; Example3: VPC ERASE >>> VPC is run previous the command and the objects ;;; are also in previous selection set ;;; ;;; c:vpc - select all visible objects with crossing in viewport ;;; c:vpw - select all visible objects with window in viewport ;;;---------------------------------------------------------------------------; (defun c:vpttt () (vpselttt "C") (princ) ) (defun c:vpwttt () (vpselttt "W") (princ) ) (defun dxf (n ed) (cdr (assoc n ed))) (defun vpselttt (typ / ad ss ent vpno ok vpbl vpur msbl msur msul mslr ss1 pl nlist x n ) (vl-load-com) (setq ok t) (if (= (getvar "tilemode") 0) (progn (setq ad (vla-get-activedocument (vlax-get-acad-object))) (if (= (getvar "cvport") 1) (if (and (= (getvar "cmdactive") 0) (setq ss (ssget "_x" (list '(0 . "VIEWPORT")))) ) (progn (setq ent (ssname ss 2)) (setq vpno (dxf 69 (entget ent))) (vla-Display (vla-get-activepviewport ad) :vlax-true) (vla-put-mspace ad :vlax-true) (setvar "cvport" vpno) ) (progn (setq ok nil) ) ) (setq ent (vlax-vla-object->ename (vla-get-activepviewport ad))) ) (if (and ok (/= 1 (logand 1 (dxf 90 (setq ed (entget ent)))))) (progn (if (= (vla-get-clipped (vlax-ename->vla-object ent)) :vlax-false ) (progn (vla-getboundingbox (vla-get-activepviewport ad) 'vpbl 'vpur ) (setq msbl (trans (vlax-safearray->list vpbl) 3 2)) (setq msur (trans (vlax-safearray->list vpur) 3 2)) (setq msul (list (car msbl) (cadr msur))) (setq mslr (list (car msur) (cadr msbl))) (setq ss1 (ssget (strcat typ "P") (list msbl msul msur mslr)) ) ) ;;; (progn ;;; (setq pl (entget (dxf 340 (entget ent)))) ;;; (setq nlist nil) ;;; (foreach x pl ;;; (if (eq 10 (car x)) ;;; (setq nlist (cons (trans (cdr x) 3 2) nlist)) ;;; ) ;;; ) ;;; (setq ss1 (ssget (strcat typ "P") nlist)) ;;; ) ) (sssetfirst nil ss1) (if ss1 (setq n (sslength ss1)) (setq n 0) ) (princ n) (princ " found ") (if (and ss1 (= (getvar "cmdactive") 1)) ss1 ) ) ) ) ) ;;; (setq ss nil ss1 nil) (setq data ss1) (setq i 0) (repeat (sslength data) (setq e (ssname data i)) (if (and (< i (sslength data)) (equal "DIMENSION" (cdr (assoc 0 (entget e)))) ) (setq entdimnstyle (entget e)) (setq newdim (subst (cons 3 "NewDimension") (assoc 3 entdimnstyle) entdimnstyle ) (entmod newdim) ) (setq i (1+ i)) ) ) ) (princ) Thank you for the input!
  5. Sunday Morning here so CAD is off.... and this idea i untested of course, so you might need to fiddle with it to make it work Adding temporary lines I would make a blank selection set, then in a loop use the line command to allow them to draw a line, add that to the selection set and ask if to draw another line or not ;;Loop for temporary lines (setq ss (ssadd)) ;; creates a blank selection set (setq LoopAgain "Y") ;; just a marker for a while loop (while (= LoopAgain "Y") (princ "Draw Line") (Command "Line" pause pause "") (setq ss (ssadd (entlast) ss) (setq LoopAgain (strcase (getstring "Draw Another Line? (Y/N)"))) ) ;;; Do your stuff ;;; ;;delete lines (repeat (setq i (sslength ss)) ;;From https://www.cadtutor.net/forum/topic/73504-deleting-a-selection-set/ (entdel (ssname ss (setq i (1- i)))) )
  6. Really nice function. Why you don't just draw line using (command "line") or something (entmake ... )? The Lee Mac function you were looking at is for jigging, I believe. It is used in combination with (grread ...) function: while in grread your cursor is moving, the coordinates is changing and the osnap mark of midpoint, center point, end point etc. show up to pick. Native grread function doesn't have those osnap marks. Lee Mac function is to add them to the grread functionality. All are based on a genius algorithm starts by Elpanov Evgeniy, I am not sure but that is as far as I know.
  7. A bit of googling you should have been able to find it also https://help.autodesk.com/view/OARX/2018/ENU/?guid=GUID-85495614-C788-45C7-8E26-2BC8A2C3A490
  8. Well found. I haven't tested in Lisp, but coding in .NET I did also find 1 viewport in an empty layout, 2 viewports in 1 viewport layout.So I always skip the first viewport. Not sure why, maybe that is something about the layout. I guess the layout itself is a special viewport.
  9. Hello. How can I do (command "_UCS" "V") with ActiveX? (do not use vl-cmdf). Thanks!!
  10. Yesterday
  11. Allan B.

    Copy Items From A List

    As it happens I found something else, the structure of my main list has errors in its assembly, and that has been causing the copy command and foreach to fail after the 1st copy was made. I have to take a break from this for a few days, I will let you know how things turn out next week. And your code was very helpful THANK YOU Allan
  12. If you DXFOUT the drawing then open the DXF file with a text editor. Search and replace one of the errant linetypes e.g. { -E- } Start with a blank drawing then DXFIN and purge a couple of times. First some blocks go then the unused linetypes.
  13. Please give it a test , maybe some defun is miss, it only work for "AcDbAlignedDimension" Feel free to add error handling or what else ...... ;************************************************************ ;; Design by Gabo CALOS DE VIT from CORDOBA ARGENTINA ;;; Copyleft 1995-2022 by Gabriel Calos De Vit ; DEVITG@GMAIL.COM ;; ; ---------------------------------------------------------------------- ; DISCLAIMER: Gabriel Calos De Vit Disclaims any and all liability for any damages ; arising out of the use or operation, or inability to use the software. ; FURTHERMORE, User agrees to hold Gabriel Calos De Vit harmless from such claims. ; Gabriel Calos De Vit makes no warranty, either expressed or implied, as to the ; fitness of this product for a particular purpose. All materials are ; to be considered ‘as-is’, and use of this software should be ; considered as AT YOUR OWN RISK. ; ---------------------------------------------------------------------- ;;************************************************************ ;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/* (DEFUN &-TEXT/STR-PT-HEI (STR PT HEIG) ;_ 01 (IF (= (TYPE PT) 'LIST) (SETQ P1 (VLAX-3D-POINT PT)) (SETQ P1 PT) ) (VLA-ADDTEXT MODEL STR P1 HEIG) ) ;;;;-******************************************************************************************************************************* ;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/* (DEFUN G-MIDPOINT/P1-P2 (P1 P2) ;_01 (MAPCAR '* '(0.5 0.5 0.5) (MAPCAR '+ P1 P2)) ) ;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/* ;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/* (DEFUN VAR->LST (VARIANT#) ;_01 (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE VARIANT#)) ) ;;*//*/*/*/*/*/*/*/*/*/*/*/*/**/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/*/* ;;;arrange-dim-text-position ;;;*************************************************************;;; ;;;https://www.cadtutor.net/forum/topic/74346-how-to-change-distance-from-dimension-line-to-objects/ (defun arrange-dim-text-position (/ ACAD-OBJ acRed ADOC DESIRED-DIST DIM-ENT-SS DIM-OBJ-SS EXTLINE1POINT-VAR EXTLINE1POINT-XYZ EXTLINE2POINT-VAR EXTLINE2POINT-XYZ MID-PT1-PT2 MODEL NEW-TEXTPOSITION-XYZ NO-WAY TEXTPOSITION-ANGLE TEXTPOSITION-OBJ TEXTPOSITION-VAR TEXTPOSITION-XYZ ) ;_ / (VL-LOAD-COM) (SETQ ACAD-OBJ (VLAX-GET-ACAD-OBJECT)) ;_ el programa ACAD (SETQ ADOC (VLA-GET-ACTIVEDOCUMENT ACAD-OBJ)) ;_ el DWG que esta abierto- (SETQ MODEL (VLA-GET-MODELSPACE ADOC)) (initget 7) (if (not (setq desired-dist (getreal "distance from side")) ) ;_ not (setq desired-dist 15.0) ) ;_ if (setq dim-ent-ss (ssget "_X" '((0 . "dim*")))) (setq dim-obj-ss (VLA-GET-ACTIVESELECTIONSET adoc)) ;;; (setq DIM-OBJ (vla-Item dim-obj-ss 0)) (vlax-for dim-obj dim-obj-ss (if(= (vla-get-ObjectName dim-obj) "AcDbAlignedDimension") (progn (setq ExtLine1Point-var (VLA-GET-ExtLine1Point dim-obj)) (setq ExtLine1Point-xyz (VAR->LST ExtLine1Point-var)) (setq ExtLine2Point-var (VLA-GET-ExtLine2Point dim-obj)) (setq ExtLine2Point-xyz (VAR->LST ExtLine2Point-var)) (setq mid-pt1-pt2 (G-MIDPOINT/P1-P2 ExtLine2Point-xyz ExtLine1Point-xyz)) (setq TextPosition-var (vla-get-TextPosition dim-obj)) (setq TextPosition-xyz (VAR->LST TextPosition-var)) (setq TextPosition-angle (angle mid-pt1-pt2 TextPosition-xyz)) (setq new-TextPosition-xyz (polar mid-pt1-pt2 TextPosition-angle desired-dist)) (vla-put-TextPosition dim-obj (VLAX-3D-POINT new-TextPosition-xyz)) );end progn (progn ;for no way to move (setq TextPosition-obj (vla-get-TextPosition dim-obj)) (setq no-way ( &-TEXT/STR-PT-HEI "NO-way " TextPosition-obj (* 2 (vla-get-TextHeight dim-obj)))) (vla-put-color no-way acred ) );end prog for no way to move );end if ) ;_ vlax-for ) ;end defun (defun c:arr-dim () (arrange-dim-text-position) ) ;;;;;;;|«Visual LISP© Format Options» ;;;(200 2 1 0 nil "end of " 100 20 2 2 nil nil T nil T) ;;;;*** DO NOT add text below the comment! ***|; arrange dim text position cadtutor.lsp arrange dim texts.dwg
  14. Linh thank you, It worked ;;;---------------------------------------------------------------------------; ;;; ;;; vpsel.lsp ;;; ;;; By Jimmy Bergmark ;;; Copyright (C) 1997-2006 JTB World, All Rights Reserved ;;; Website: www.jtbworld.com ;;; E-mail: info@jtbworld.com ;;; ;;; 2000-04-14 - First release ;;; Tested on AutoCAD 2000 ;;; ;;;---------------------------------------------------------------------------; ;;; DESCRIPTION ;;; ;;; Select all visible objects in selected or active paperspace viewport ;;; Works transparently when in modelspace and for polygonal viewports too ;;; Example1: ERASE ALL R 'VPC >>> Erase all in model except what is visible ;;; Example2: (command "erase" "all" "r" (c:vpc) "") ;;; Example3: VPC ERASE >>> VPC is run previous the command and the objects ;;; are also in previous selection set ;;; ;;; c:vpc - select all visible objects with crossing in viewport ;;; c:vpw - select all visible objects with window in viewport ;;;---------------------------------------------------------------------------; (defun c:vpttt () (vpselttt "C") (princ) ) (defun c:vpwttt () (vpselttt "W") (princ) ) (defun dxf (n ed) (cdr (assoc n ed))) (defun vpselttt (typ / ad ss ent vpno ok vpbl vpur msbl msur msul mslr ss1 pl nlist x n ) (vl-load-com) (setq ok t) (if (= (getvar "tilemode") 0) (progn (setq ad (vla-get-activedocument (vlax-get-acad-object))) (if (= (getvar "cvport") 1) (if (and (= (getvar "cmdactive") 0) (setq ss (ssget "_x" (list '(0 . "VIEWPORT")))) ) (progn (setq ent (ssname ss 0)) (setq vpno (dxf 69 (entget ent))) (vla-Display (vla-get-activepviewport ad) :vlax-true) (vla-put-mspace ad :vlax-true) (setvar "cvport" vpno) ) (progn (setq ok nil) ) ) (setq ent (vlax-vla-object->ename (vla-get-activepviewport ad))) ) (if (and ok (/= 1 (logand 1 (dxf 90 (setq ed (entget ent)))))) (progn (if (= (vla-get-clipped (vlax-ename->vla-object ent)) :vlax-false ) (progn (vla-getboundingbox (vla-get-activepviewport ad) 'vpbl 'vpur ) (setq msbl (trans (vlax-safearray->list vpbl) 3 2)) (setq msur (trans (vlax-safearray->list vpur) 3 2)) (setq msul (list (car msbl) (cadr msur))) (setq mslr (list (car msur) (cadr msbl))) (setq ss1 (ssget (strcat typ "P") (list msbl msul msur mslr)) ) ) (progn (setq pl (entget (dxf 340 (entget ent)))) (setq nlist nil) (foreach x pl (if (eq 10 (car x)) (setq nlist (cons (trans (cdr x) 3 2) nlist)) ) ) (setq ss1 (ssget (strcat typ "P") nlist)) ) ) (sssetfirst nil ss1) (if ss1 (setq n (sslength ss1)) (setq n 0) ) (princ n) (princ " found ") (if (and ss1 (= (getvar "cmdactive") 1)) ss1 ) ) ) ) ) (setq ss nil ss1 nil) ) (princ) The only thing is that, when I count my viewports it says 3 from 0-2, but I have only 2 in paper space under 0 and 2 We figure it out, but I didn't get how and why... Thank you!!!
  15. + aa is not empty, but there is case your user has a drawing without any viewport, and aa is empty. Your software must take care all the cases. + if the 340 dxf is nil, the viewport is not clipped. It should fall into the first "if condition" above: (if (= (vla-get-clipped (vlax-ename->vla-object vp)) :vlax-false ) why it fell to the 2nd condition, i don't know I also note that if you have 3 viewport, can you highlight entities in all 3 viewports? I think AutoCAD only allow 1. Anyway, if your purpose is get the entities, not highlight them, then ok. You can get list of entities from everywhere in the database.
  16. I have wrote this LSP to ask the user to pick a gap tolerance before hatching and hatch the area. The program then gets the area and converts that to m2 and asks the user to pick a selection of either DTEXT or MTEXT to update. I was hoping at the every start of the program to draw a few temporary separate lines before asking for the gap tolerance to allow the user to divide the space up if needed or to close up any very large gaps. I did look at this example but it's way over my head. http://www.lee-mac.com/lisp/html/GrSnapV1-0.html Here's the program code below and it in action. (defun c:Area_Get_Picked_Mod_Text( / *error* var_hpislanddetection var_hpgaptol var_cmdecho var_nomutt var_osmode gaptolerance pthatch ss areainmmval areacmdstr mtextcontents i ent i str ent ) (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) (setvar 'nomutt var_nomutt) (setvar 'osmode var_osmode) (setvar 'hpgaptol var_hpgaptol) (setvar 'hpislanddetection var_hpislanddetection) ) (setq var_hpislanddetection (getvar "hpislanddetection")) (setq var_hpgaptol (getvar "hpgaptol")) (setq var_cmdecho (getvar "cmdecho")) (setq var_nomutt (getvar "nomutt")) (setq var_osmode (getvar "osmode")) (setvar 'hpislanddetection 2) ; 0 Normal. Hatches islands within islands. 1 Outer. Hatches only areas outside of islands. 2 Ignore. Hatches everything within the boundaries. (setvar 'cmdecho 0) (setvar 'osmode 0) ; Get hpgaptol variable (setq gaptoleranceDefault (getvar "hpgaptol")) ; Prompt for distance, if nil use default (setq gaptolerance (cond ((getdist (strcat "\nPick or enter the gap tolerance for the hatched area :\nCurrent value <" (vl-princ-to-string (getvar "hpgaptol")) ">: "))) (gaptoleranceDefault) ) ) ; Click the internal area for the hatching (graphscr) (setq pthatch (getpoint "\nClick internal point : "))(terpri) (command "-hatch" "_P" "_S" "_T" "70" "_A" "_G" gaptolerance "" pthatch "" ) ; Use the area command to get the last value (command "._area" "_O" "_L") (setq areainmmval (rtos (/ (getvar "area") 1e6) 2 2)) ; How to get m² from mm² in area in AutoCAD. https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/mm2-to-m2-soma-areas-m2-lsp-and-mm-to-m-soma-perimetros-lsp/m-p/5963137/highlight/true#M337718 (setq areacmdstr (strcat "\n\nArea in m\U+00B2 is: " areainmmval)) (setq mtextcontents (strcat areainmmval "m\U+00B2")) (terpri)(princ (strcat areacmdstr))(terpri) ; Select the MTEXT that needs to get updated (Can be multiple selection) (terpri)(prompt "Select the MTEXT you want to update:")(terpri) (setvar 'nomutt 1) ; Setting the numutt variable to 1 allows the prompt to show up. See: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/ssget-with-custom-prompt/m-p/1735374#M219362 ; (setq ss (ssget '((0 . "MTEXT,TEXT")))) (setq ss (ssget '((0 . "*TEXT")))) (setvar 'nomutt 0) ; Modify the selected MTEXT with the area (if ss (repeat (setq i (sslength ss)) (setq ent (entget (ssname ss (setq i (1- i)))) str (cdr (assoc 1 ent)) ) (if (wcmatch str "*") (progn (setq regex (vlax-create-object "Vbscript.RegExp")) (vlax-put-property regex "IgnoreCase" 1) (vlax-put-property regex "Global" 1) (setq regexp_oldstr "\\d+\\.?\\d*m[²|2]") (vlax-put-property regex "Pattern" regexp_oldstr ) (setq result (vlax-invoke-method regex "Replace" str mtextcontents) ) (setq str (vl-string-translate "*" " " result) ) (setq ent (subst (cons 1 str) (assoc 1 ent) ent)) (entmod ent) ) ) ) ) ; (command "._erase" "_L" pause) ; This will auto select the last item to get deleted. This is just for double checking it was hatched correctly. (command "._erase" "_L" "") ; This will delete the last object created. (setvar 'cmdecho var_cmdecho) (setvar 'nomutt var_nomutt) (setvar 'osmode var_osmode) (*error* nil) (princ) )
  17. HELLO in this LISP i want the multiple selection WITH RECTANGLE WINDOW and not the single selection is possible? #NESTEND BLOCK COPY WITHOUT OPEN THEM (defun c:cx (/ *error* space ss nent br copy) (vl-load-com) (or *acad* (setq *acad* (vlax-get-acad-object))) (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*))) (defun *error* (msg) (and msg (/=(strcase msg) "FUNCTION CANCELLED") (princ (strcat "\nError: " msg)) ) (vla-EndUndoMark *acdoc*) (princ) ) (vla-StartUndoMark *acdoc*) (setq space (if (= 1 (getvar 'cvport)) (vla-get-PaperSpace *acdoc*) (vla-get-ModelSpace *acdoc*) ) ) (setq ss (ssadd)) (while (and (setq nent (nentselp "\nSelect a nested block: ")) (= 4 (length nent)) (= "AcDbBlockReference" (vla-get-ObjectName (setq br (vlax-ename->vla-object (car (last nent)))))) (apply '= (mapcar 'abs (list (vla-get-XScaleFactor br) (vla-get-YScaleFactor br) (vla-get-ZScaleFactor br)))) ) (setq copy (vla-insertblock space (vlax-3d-point '(0 0 0)) (vla-get-Name br) 1.0 1.0 1.0 0.0)) (vla-TransformBy copy (vlax-tmatrix (caddr nent))) (vla-Highlight copy :vlax-true) (ssadd (vlax-vla-object->ename copy) ss) ) (command "_.move" ss "") (*error* nil) )
  18. Steven P

    Copy Items From A List

    I was expecting "entity name" to be a point (x y z) ....
  19. "Select All Entities Within Viewport" , I agree its a better name Yes the loop will be later, for now I want any of 2 viewports to be selected. Done. aa result (entget vp) - result is, ((-1 . <Entity name: 14d67bf58d0>) (0 . "VIEWPORT") (330 . <Entity name: 14d03befec0>) (5 . "335") (100 . "AcDbEntity") (67 . 1) (410 . "Layout1") (8 . "G-ANNO-NPLT") (100 . "AcDbViewport") (10 -306.971 81.0516 0.0) (40 . 155.262) (41 . 128.7) (68 . 2) (69 . 3) (12 21977.9 5012.98 0.0) (13 0.0 0.0 0.0) (14 0.0 0.0 0.0) (15 0.0 0.0 0.0) (16 0.0 0.0 1.0) (17 0.0 0.0 0.0) (42 . 0.0) (43 . 0.0) (44 . 0.0) (45 . 12870.0) (50 . 0.0) (51 . 0.0) (72 . 1000) (90 . 32768) (1 . "") (281 . 0) (71 . 1) (74 . 1) (110 0.0 0.0 0.0) (111 1.0 0.0 0.0) (112 0.0 1.0 0.0) (79 . 0) (146 . 0.0) (170 . 0) (61 . 5) (348 . <Entity name: 14d03befaf0>) (292 . 1) (282 . 1) (141 . 0.0) (142 . 0.0) (63 . 250) (421 . 3355443)) (dxf 340 (entget ent)) - result is, nil ( there is no dxf for 340) ;;;---------------------------------------------------------------------------; ;;; ;;; vpsel.lsp ;;; ;;; By Jimmy Bergmark ;;; Copyright (C) 1997-2006 JTB World, All Rights Reserved ;;; Website: www.jtbworld.com ;;; E-mail: info@jtbworld.com ;;; ;;; 2000-04-14 - First release ;;; Tested on AutoCAD 2000 ;;; ;;;---------------------------------------------------------------------------; ;;; DESCRIPTION ;;; ;;; Select all visible objects in selected or active paperspace viewport ;;; Works transparently when in modelspace and for polygonal viewports too ;;; Example1: ERASE ALL R 'VPC >>> Erase all in model except what is visible ;;; Example2: (command "erase" "all" "r" (c:vpc) "") ;;; Example3: VPC ERASE >>> VPC is run previous the command and the objects ;;; are also in previous selection set ;;; ;;; c:vpc - select all visible objects with crossing in viewport ;;; c:vpw - select all visible objects with window in viewport ;;;---------------------------------------------------------------------------; (defun c:vpc () (vpsel "C") (princ) ) (defun c:vpw () (vpsel "W") (princ) ) (defun dxf (n ed) (cdr (assoc n ed))) (defun vpsel (typ / ad ss ent vpno ok vpbl vpur msbl msur msul mslr ss1 pl nlist x n ) (vl-load-com) (setq ok t) ;;; (if (= (getvar "tilemode") 0) ;;; (progn ;;; ;;; (if (= (getvar "cvport") 1) ;;; (if (and (= (getvar "cmdactive") 0) ;;; (/= (setq ss (ssget ":E:S" '((0 . "VIEWPORT")))) nil) ;;; ) (progn (setq ad (vla-get-activedocument (vlax-get-acad-object))) (setq aa (ssget "_x" (list '(0 . "VIEWPORT")))) (setq vp (ssname aa 0)) ;;; ;;; (setq ent rrr) ;;; (setq ent (car (entget Ent1))) (setq vpno (dxf 69 (entget vp))) (vla-Display (vla-get-activepviewport ad) :vlax-true) (vla-put-mspace ad :vlax-true) (setvar "cvport" vpno) ) (progn (setq ok nil) ) ;;; ) (setq vp (vlax-vla-object->ename (vla-get-activepviewport ad))) (if (and ok (/= 1 (logand 1 (dxf 90 (setq ed (entget vp)))))) (progn (if (= (vla-get-clipped (vlax-ename->vla-object vp)) :vlax-false ) (progn (vla-getboundingbox (vla-get-activepviewport ad) 'vpbl 'vpur ) (setq msbl (trans (vlax-safearray->list vpbl) 3 2)) (setq msur (trans (vlax-safearray->list vpur) 3 2)) (setq msul (list (car msbl) (cadr msur))) (setq mslr (list (car msur) (cadr msbl))) (setq ss1 (ssget (strcat typ "P") (list msbl msul msur mslr)) ) ) (progn (setq pl (entget (dxf 340 (entget vp)))) (setq nlist nil) (foreach x pl (if (eq 10 (car x)) (setq nlist (cons (trans (cdr x) 3 2) nlist)) ) ) (setq ss1 (ssget (strcat typ "P") nlist)) ) ) (sssetfirst nil ss1) (if ss1 (setq n (sslength ss1)) (setq n 0) ) (princ n) (princ " found ") (if (and ss1 (= (getvar "cmdactive") 1)) ss1 ) ) ) ;;; (setq ss nil ss1 nil) ;;; (setq sss (ssadd)) ;;; (ssadd ent sss) ;;; (setq rrr (ssadd ss1 sss)) ) (princ) Thank you!
  20. I think the topic name should be changed to something relate to "Select All Entities Within Viewport" or so. I can't try debug your code but I see: (setq aa (ssget "_x" (list '(0 . "VIEWPORT")))) (setq ent (ssname aa 0)) You select all viewport in the layouts but instead of loop through each viewport, you set the ent to the first item in the selection set. Firstly, better rename "ent" to "viewport" or "vp" to clarify the code. Second, the aa can be empty so the (ssname aa 0) returns error. (setq ent (vlax-vla-object->ename (vla-get-activepviewport ad))) Few lines next, you drop the ent's viewport value and get the new value from activeviewport of the activedocument ad. So the (setq aa (ssget ...)) lines are useless, all the retrieved values are thrown away. In the original code, the programmer takes care of 2 cases: 1. is in a layout, paper space 2. is in a layout, but in mspace, (the cursor is within a viewport) For the viewport (ent), it also has 2 cases: + normal viewport: its boundary is a rectangle + clipped viewport: its boundary is some polyline, that is what this code is all about: (setq pl (entget (dxf 340 (entget ent)))) if error raises, try debug by put to watch, ent, (entget ent), (dxf 340 (entget ent)) to see anything is nil Just curious, is there in the world a kind of homework in AutoLisp? I am self taught (actually the web taught me), and I never know there is Autolisp study in any school
  21. Trial and error...Crime and Punishment Here is the updated code: ;;;---------------------------------------------------------------------------; ;;; ;;; vpsel.lsp ;;; ;;; By Jimmy Bergmark ;;; Copyright (C) 1997-2006 JTB World, All Rights Reserved ;;; Website: www.jtbworld.com ;;; E-mail: info@jtbworld.com ;;; ;;; 2000-04-14 - First release ;;; Tested on AutoCAD 2000 ;;; ;;;---------------------------------------------------------------------------; ;;; DESCRIPTION ;;; ;;; Select all visible objects in selected or active paperspace viewport ;;; Works transparently when in modelspace and for polygonal viewports too ;;; Example1: ERASE ALL R 'VPC >>> Erase all in model except what is visible ;;; Example2: (command "erase" "all" "r" (c:vpc) "") ;;; Example3: VPC ERASE >>> VPC is run previous the command and the objects ;;; are also in previous selection set ;;; ;;; c:vpc - select all visible objects with crossing in viewport ;;; c:vpw - select all visible objects with window in viewport ;;;---------------------------------------------------------------------------; (defun c:vpc () (vpsel "C") (princ) ) (defun c:vpw () (vpsel "W") (princ) ) (defun dxf (n ed) (cdr (assoc n ed))) (defun vpsel (typ / ad ss ent vpno ok vpbl vpur msbl msur msul mslr ss1 pl nlist x n ) (vl-load-com) (setq ok t) ;;; (if (= (getvar "tilemode") 0) ;;; (progn ;;; ;;; (if (= (getvar "cvport") 1) ;;; (if (and (= (getvar "cmdactive") 0) ;;; (/= (setq ss (ssget ":E:S" '((0 . "VIEWPORT")))) nil) ;;; ) (progn (setq ad (vla-get-activedocument (vlax-get-acad-object))) (setq aa (ssget "_x" (list '(0 . "VIEWPORT")))) (setq ent (ssname aa 0)) ;;; ;;; (setq ent rrr) ;;; (setq ent (car (entget Ent1))) (setq vpno (dxf 69 (entget ent))) (vla-Display (vla-get-activepviewport ad) :vlax-true) (vla-put-mspace ad :vlax-true) (setvar "cvport" vpno) ) (progn (setq ok nil) ) ;;; ) (setq ent (vlax-vla-object->ename (vla-get-activepviewport ad))) (if (and ok (/= 1 (logand 1 (dxf 90 (setq ed (entget ent)))))) (progn (if (= (vla-get-clipped (vlax-ename->vla-object ent)) :vlax-false ) (progn (vla-getboundingbox (vla-get-activepviewport ad) 'vpbl 'vpur ) (setq msbl (trans (vlax-safearray->list vpbl) 3 2)) (setq msur (trans (vlax-safearray->list vpur) 3 2)) (setq msul (list (car msbl) (cadr msur))) (setq mslr (list (car msur) (cadr msbl))) (setq ss1 (ssget (strcat typ "P") (list msbl msul msur mslr)) ) ) (progn (setq pl (entget (dxf 340 (entget ent)))) (setq nlist nil) (foreach x pl (if (eq 10 (car x)) (setq nlist (cons (trans (cdr x) 3 2) nlist)) ) ) (setq ss1 (ssget (strcat typ "P") nlist)) ) ) (sssetfirst nil ss1) (if ss1 (setq n (sslength ss1)) (setq n 0) ) (princ n) (princ " found ") (if (and ss1 (= (getvar "cmdactive") 1)) ss1 ) ) ) ;;; (setq ss nil ss1 nil) ;;; (setq sss (ssadd)) ;;; (ssadd ent sss) ;;; (setq rrr (ssadd ss1 sss)) ) (princ) I got stuck on this line: it produces an error Please help. Basically looking for tutor. I will do my homework:) It highlight the viewport but doesn't select it. Going through each line and checking data. Error on this line: (setq pl (entget (dxf 340 (entget ent))))
  22. Last week
  23. BIGAL

    Beginner

    Is it not a DRAWORDER question, it does what you wantt like move to top.
  24. Allan B.

    Copy Items From A List

    Sorry Steve it did copy fine, now to to try it with my objects
  25. Allan B.

    Copy Items From A List

    No luck yet. I setup 2 new circle entities and put them in a list, and verified them , no confusion with any other objects or lists. Than I defined your code as a defun() . next I ran the function, the result entity name _______ entity name _______ -count : 0 pt : < entity name --------->copy ok -count : 1 pt : < entity name---------> copy oK But nothing got copied Allan
  26. It appears to be the polar function, this works: (setq mpt (mapcar '/ (mapcar '+ ll ur) '(2 2 2)))
  27. Change this: (list (max (last ll) (last ur))) To this: (list (+ 0.01 (max (last ll) (last ur))))
  28. Any idea whats going on with my lisp @ronjonp ? The bounding box is right something to do with computing the wrong angle? Is the UCS not world? or is it object snapping?
  29. Wow, works great! Is it possible to change the Z location of the labels from current Z to current Z +0.01 so the text doesn't get skewed by shading when viewing in realistic 3d mode
  1. Load more activity
×
×
  • Create New...