Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 02/27/2019 in all areas

  1. A little bit more (setq lay (cdr (assoc 8 (entget (car (entsel "pick object for layer")))))) (setq s (ssget "_F" p (list (cons 0 "line") (cons 8 lay))))
    1 point
  2. I have gone away from initget to using dcl's with radio buttons. It would make sense to highlight the button that has been previously picked so you just pick OK. This code needs that added Grrr you out there ? ; Multi button Dialog box for a single choice replacement of initget ; By Alan H Feb 2019 ; Example code ; (setq butlst '("A B or C " "A" "B" "C" ) ) ; (if (not AH:Butts)(load "Radio buttons multi.lsp")) ; (setq ans (ah:butts "V" butlst)) ; ans holds the button picked value ; (setq butlst '("Yes or No" "Yes" "No")) ; (if (not AH:Butts)(load "Radio buttons multi.lsp")) ; (setq ans (ah:butts "h" butlst)) ; ans holds the button picked value (vl-load-com) (defun AH:Butts (verhor butlst / fo fname x k ) (setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w")) (write-line "AHbutts : dialog {" fo) (write-line (strcat " label =" (chr 34) (nth 0 butlst) (chr 34) " ;" )fo) (write-line " : row {" fo) (if (= (strcase verhor) "V") (write-line " : boxed_radio_column {" fo) (write-line " : boxed_radio_row {" fo) ) (setq x 1) (repeat (- (length butlst) 1) (write-line " : radio_button {" fo) (write-line (strcat "key = " (chr 34) "Rb" (rtos x 2 0) (chr 34) ";") fo) (write-line (strcat "label = " (chr 34) (nth x butlst) (chr 34) ";") fo) (write-line " }" fo) (setq x (+ x 1)) ) (write-line " }" fo) (write-line " }" fo) (write-line " ok_only;" fo) (write-line " }" fo) (close fo) (setq dcl_id (load_dialog fname)) (if (not (new_dialog "AHbutts" dcl_id) ) (exit) ) (setq x 1) (repeat (- (length butlst) 1) (setq k (strcat "Rb" (rtos x 2 0))) (action_tile k (strcat "(setq but " (rtos x 2 0) ")" "(done_dialog)")) (setq x (+ x 1)) ) (start_dialog) (unload_dialog dcl_id) (vl-file-delete fname) ; which one picked (nth but butlst) ) ; these 2 lines are the calling code in a seperate lisp program (if (not Ah:Butts4)(load "Radio buttons multi")) (setq pos (AH:Butts4 "V" "Choose A B C D" "A" "B" "C" "D")) ; check val1 val2 val3 val4 for = "1" this is picked button.
    1 point
  3. Sure .. change the ssget filter: (setq s (ssget "_F" p '((0 . "line") (8 . "yourlayer"))))
    1 point
  4. The main function (c:ProjectTopRegionPoints) will detect the 'top' region automatically. So it should work from a script.
    1 point
  5. Placing the points on the Z=0 plane actually makes more sense. They can then be used for snapping when arranging these furniture blocks in plan. Revised code: (defun KGA_Conv_Pickset_To_ObjectList (ss / i ret) (if ss (repeat (setq i (sslength ss)) (setq ret (cons (vlax-ename->vla-object (ssname ss (setq i (1- i)))) ret)) ) ) ) (defun KGA_Geom_ObjectMiddle (obj / ptBL ptTR) (vla-getboundingbox obj 'ptBL 'ptTR) (mapcar '/ (mapcar '+ (vlax-safearray->list ptBL) (vlax-safearray->list ptTR)) '(2.0 2.0 2.0) ) ) (defun KGA_List_DuplicateRemoveAllEqual (lst fuzz / ret) (mapcar '(lambda (a) (if (vl-every '(lambda (b) (not (equal a b fuzz))) ret ) (setq ret (cons a ret)) ) ) lst ) (reverse ret) ) (defun RegionPointList (reg / objLst ptLst) ; Reg as vla-object. (setq objLst (vlax-invoke reg 'explode)) (setq ptLst (KGA_List_DuplicateRemoveAllEqual (apply 'append (mapcar '(lambda (obj) (if (vlax-property-available-p obj 'startpoint) (list (vlax-get obj 'startpoint) (vlax-get obj 'endpoint) ) ) ) objLst ) ) 1e-8 ) ) (mapcar 'vla-delete objLst) ptLst ) (defun TopRegion (objLst / mid reg tmp) (setq reg (car objLst)) (setq mid (KGA_Geom_ObjectMiddle reg)) (foreach obj (cdr objLst) (if (< (caddr mid) (caddr (setq tmp (KGA_Geom_ObjectMiddle obj)))) (setq reg obj mid tmp) ) ) reg ) (defun c:ProjectTopRegionPoints ( / doc reg spc ss) ; Places a point on the Z=0 projection of every vertex of the 'top' region in modelspace. (setq doc (vla-get-activedocument (vlax-get-acad-object))) (vla-endundomark doc) (vla-startundomark doc) (if (setq ss (ssget "_X" '((0 . "REGION") (410 . "Model")))) (progn (setq reg (TopRegion (KGA_Conv_Pickset_To_ObjectList ss))) (setq spc (vla-get-modelspace doc)) (foreach pt (RegionPointList reg) (vla-addpoint spc (vlax-3d-point (list (car pt) (cadr pt) 0.0)) ) ) ) ) (vla-endundomark doc) (princ) )
    1 point
  6. Hi, maybe this help. https://www.theswamp.org/index.php?topic=49892.0
    1 point
  7. By adding "@" should work, but is better to look to POLAR function instead. Also, take care to avoid interference with current auto OSNAP and conflicts with a localized version of AutoCAD/redefined commands. (command "_.LINE" "_non" point1 "_non" (polar point1 (* (/ -170.0 180.0) pi) 3860.0) "")
    1 point
×
×
  • Create New...