Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 08/14/2021 in all areas

  1. Hi, heres my attempt: (defun C:test ( / attName zoomScaleFactor LM:ViewportExtents acApp acDoc SS i zm tH pL ) (setq attName "NUMER") (setq zoomScaleFactor 10) ;; Viewport Extents - Lee Mac ;; Returns two WCS points describing the lower-left and upper-right corners of the active viewport. (defun LM:ViewportExtents ( / c h v ) (setq c (trans (getvar 'viewctr) 1 0) h (/ (getvar 'viewsize) 2.0) v (list (* h (apply '/ (getvar 'screensize))) h) ) (list (mapcar '- c v) (mapcar '+ c v)) ) (setq acDoc (vla-get-ActiveDocument (setq acApp (vlax-get-acad-object)))) (if (setq SS (ssget '((0 . "INSERT")(2 . "bik_BlkOpPret,bik_BlkOpPretU,bik_BlkOpPretW")(66 . 1)))) (progn (repeat (setq i (sslength SS)) (vl-some '(lambda (att) (if (= (vlax-get att 'TagString) attName) (progn (or tH (setq tH (vlax-get att 'Height))) (setq pL (cons ( (lambda (s) (substr s 2 (strlen s))) (apply 'strcat (mapcar '(lambda (x) (strcat "," (rtos x 2 3))) (vlax-get att 'TextAlignmentPoint))) ) pL ) ) ) ) ) (vlax-invoke (vlax-ename->vla-object (ssname SS (setq i (1- i)))) 'GetAttributes) ) ); repeat (setq zm (LM:ViewportExtents)) (foreach p pL (command "._circle" "_non" p "32") ; comment when required ; (command "._delay" 300) ; for testing purposes - in order to adjust the 'zoomScaleFactor' (vla-ZoomCenter acApp (vlax-3D-point (read (vl-list->string (subst 32 44 (vl-string->list (strcat "(" p ")")))))) (* zoomScaleFactor tH)) ; (vla-SendCommand acDoc (strcat "bik_mop " p " ")) ; uncomment when required ); foreach (apply 'vla-ZoomWindow (cons (vlax-get-acad-object) (mapcar '(lambda (p) (vlax-3D-point (append p '(0.0)))) zm))) ); progn ); if (princ) ); defun (vl-load-com) (princ)
    1 point
  2. Thank You @devitg. You did great job. Never thought it will be so hard (so long and hard code). I wilk check setq insertion but probably i did it like this but it wasn't working cause of strcat Now for me is most importamt to make it zoom like I wan't
    1 point
  3. With a Northing of 17.835993 and an Easting of 79.79603567 my guess is those values are Latitude and Longitude and would be better displayed in DMS format. Where did this text come from?
    1 point
  4. Hi @pmadhwal7, please explain from where this mtext comes from . It seem to be some like a surveyor dwg. And made from a LISP or other api used . The only way I see to do it, is EDIT by LISP all MTEXT and change as need to be with a LISP routine . Please upload a new DWG with a few more mtext I will try to fix it by a LISP. Other fact,
    1 point
  5. please test , it was my error , it is not the ATT insertionpoint, it is the TEXTALIGMENTPOINT ;****************************************************************************************** (DEFUN GETALLATTRIBUTES/OBJ (OBJSELECTION /) (IF (= (TYPE OBJSELECTION) 'ENAME) (SETQ OBJSELECTION (VLAX-ENAME->VLA-OBJECT OBJSELECTION)) ) (IF (VLAX-PROPERTY-AVAILABLE-P OBJSELECTION "hasattributes") (IF (= (VLA-GET-HASATTRIBUTES OBJSELECTION) :VLAX-TRUE) (VLAX-SAFEARRAY->LIST (VARIANT-VALUE (VLA-GETATTRIBUTES OBJSELECTION) ) ) ) ) ) ;;..ggk[[gg ;****************************************************************************************** (DEFUN NAMED-ATT-INSERTION ( / ACAD-OBJ ADOC ATT-NAME ATT-XYZ INSERT-OBJ INSERT-OBJ-ATTS INSERT-OBJ-SS LAY-COLL MODEL SS ) (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 ATT-NAME "NUMER") (IF (SETQ SS (SSGET "_:S+." '((0 . "INSERT") (2 . "bik_BlkOpPret,bik_BlkOpPretU,bik_BlkOpPretW")))) (PROGN (SETQ INSERT-OBJ-SS (VLA-GET-ACTIVESELECTIONSET ADOC)) (SETQ INSERT-OBJ (VLA-ITEM INSERT-OBJ-SS 0)) (SETQ INSERT-OBJ-ATTS (GETALLATTRIBUTES/OBJ INSERT-OBJ)) ;;(setq atts (nth 0 insert-obj-atts)) (FOREACH ATTS INSERT-OBJ-ATTS (IF (= (VLA-GET-TAGSTRING ATTS) ATT-NAME) (SETQ ATT-XYZ (VLAX-SAFEARRAY->LIST (VLAX-VARIANT-VALUE (VLA-GET-TEXTALIGNMENTpoint ATTS)))) ) ; end if ) ;end foreach (VLA-ADDCIRCLE MODEL (VLAX-3D-POINT ATT-XYZ) 32) ) ) ) ;|«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! ***|;
    1 point
  6. Also you can set LUPREC value to 6 type LUPREC at command line , and set to 6
    1 point
  7. I saw this last night and was intrigued, so here is my version, adding in the ability to select many lines (lines and polylines, finishing with filleted polylines)(you can limit this to just polylines). Also because it is for me, option to set the chamfer length, fillet radius and the angle each time (maybe later to fix this to set a value or press enter to keep a value) (defun c:filletends ( / chamferlength chamferangle filletradius MyLines MyLine acount) ;;Get inputs ;;Lengths and Radius ;;modify this as required ;;;;;;;;;;;;;;;;;;;;;;;;;; (setq chamferlength (getreal "\nEnter Chamfer Length: ")) (setq filletradius (getreal (strcat "\nEnter Fillet Radius: "))) (setq chamferangle (getreal "\nEnter Chamfer Angle: ")) ;;-or set angles and lengths in LISP-;; ; (setq chamferlength 10) ; (setq filletradius 10) ; (setq chamferangle 45) ;;;;;;;;;;;;;;;;;;;;;;;;;; ;;Select Lines (princ "Select Lines") (setq MyLines (ssget '((0 . "*LINE") ))) ;;change to LWPOLYLINE if just wanting polylines (setq acount 0) ;;Run Make fillet routine (while (< acount (sslength MyLines)) (setq MyLine (ssname MyLines acount)) (filletends MyLine chamferlength chamferangle filletradius) (setq acount (+ acount 1)) ) (princ) ) ;;Make Fillet Routine (defun filletends ( myline chamferlength chamferangle filletradius / maxfilletradius filletangle lineent enda endb mylinelength mylineangle linea lineb) ;;Subroutines (defun RadtoDeg( r / ) (* 180.0 (/ r pi)) ) (defun DegtoRad (d / ) (* pi (/ d 180.0)) ) (defun TAN (z / ) (/ (sin z) (cos z)) ) ;;Get line end points, length and angle (if ( = (cdr (assoc 0 (entget myline))) "LWPOLYLINE") ;;fixes a thing (progn (command "_.explode" myline) (setq myline (entlast)) ) ) (setq lineent (entget myline)) (setq enda (cdr (assoc 10 lineent)) ) (setq endb (cdr (assoc 11 lineent)) ) (setq mylinelength (distance enda endb)) (setq mylineangle (RadtoDeg (angle enda endb))) ;;If you want, these 2 lines to make the chamfer length and fillet radius a percent of the original line length;; ;; (setq chamferlength (* ( / chamferlength 100.0) mylinelength) ) ;; (setq filletradius (* ( / filletradius 100.0) mylinelength) ) ;;draw lines. Might be faster to do entmake but not much (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (command "line" enda (STRCAT "@" (rtos chamferlength) "<" (rtos (- mylineangle (- 180 chamferangle)) 2)) "") (setq linea (entlast)) (command "line" endb (STRCAT "@" (rtos chamferlength) "<" (rtos (- mylineangle chamferangle) 2)) "") (setvar 'osmode oldsnap) (setq lineb (entlast)) (command "_.pedit" "m" linea myline lineb "" "Y" "J" "" "") ;;Make Fillets (if (< chamferlength (/ mylinelength 2)) (setq smallestline chamferlength) (setq smallestline (/ mylinelength 2) ) ) (setq maxfilletradius (abs(* (TAN (DegtoRad ( - 90 (/ (abs chamferangle) 2))) ) smallestline)) ) (if ( > filletradius maxfilletradius) (setq filletradius (* maxfilletradius 0.95)) ) (setvar "filletrad" (abs filletradius)) (command "_.fillet" "_polyline" (entlast)) (princ) )
    1 point
  8. Another, change off and rad to suit. ; 45 ends to a single line or pline ; BY alanH info@alanh.com.au ; Aug 2021 (defun doline ( / d1 d2) (setq pt1 (vlax-get Obj 'StartPoint)) (setq pt2 (vlax-get Obj 'EndPoint)) (setq d1 (distance pt1 pt3) d2 (distance pt2 pt3) ) (if (< d1 d2) (progn (setq temp pt1) (setq pt1 pt2) (setq pt2 temp) ) ) (princ) ) (defun dopl ( / d1 d2 temp) (setq pt1 (vlax-curve-getStartPoint obj)) (setq pt2 (vlax-curve-getEndPoint obj)) (setq d1 (distance pt1 pt3) d2 (distance pt2 pt3) ) (if (< d1 d2) (progn (setq temp pt1) (setq pt1 pt2) (setq pt2 temp) ) ) (princ) ) (defun C:45ends ( / oldsnap pt1 pt2 pt3 pt4 pt5 pt6 off rad ent) (setq oldsnap (getvar 'osmode)) (setvar 'osmode 0) (setq off 10.0 rad 10.0) (setvar 'filletrad rad) (while (setq ent (entsel "\npick p/line near end Enter to exit")) (setq pt3 (cadr ent)) (setq obj (vlax-ename->vla-object (car ent))) (cond ((= (vla-get-objectname obj) "AcDbLine")(doline)) ((= (vla-get-objectname obj) "AcDbPolyline")(dopl)) ) (setq ang (angle pt1 pt2)) (setq pt3 (polar pt1 (- ang (/ pi 2.0)) off)) (setq pt4 (polar pt2 (- ang (/ pi 2.0)) off)) (setq pt5 (polar pt3 (+ (* pi 0.25) ang) off)) (command "line" pt3 pt5 "") (setq pt5 (mapcar '* (mapcar '+ pt3 pt5) '(0.5 0.5))) (command "fillet" ent pt5) (setq pt6 (polar pt4 (+ ang (* pi 0.75)) off)) (command "line" pt4 pt6 "") (setq pt6 (mapcar '* (mapcar '+ pt4 pt6) '(0.5 0.5)))4 (command "fillet" ent pt6) ) (setvar 'osmode oldsnap) (princ) )
    1 point
×
×
  • Create New...